WebGadget (Windows) and VARIANT parameter

firace · Post by **firace** » Thu Jan 03, 2019 11:51 pm

As a continuation of this other question, I'm now trying to retrieve the URL of a NavigateError event (lines 82-95), but am getting totally lost in the VARIANT stuff. Any ideas from API gurus welcome!

Note: Of course I could simply use "Debug GetGadgetText(0)" in the below example, but that wouldn't help if the NavigateError refers to a resource (image, script, etc) loaded by the page.

Code: Select all

;;; very old snippet, not sure of the original author.

#DISPID_DOWNLOADCOMPLETE   = 104 
#DISPID_NEWWINDOW3 = 273 
#DISPID_DOCUMENTCOMPLETE = $00000103 
#DISPID_FILEDOWNLOAD = $0000010E 
#DISPID_PROGRESSCHANGE = $0000006C 
#DISPID_BEFORENAVIGATE2 = $000000FA 
#DISPID_NEWWINDOW2 = 251 
#DISPID_NAVIGATEERROR=  271


Structure DispatchFunctions 
  QueryInterface.i
  AddRef.i
  Release.i 
  GetTypeInfoCount.i 
  GetTypeInfo.i
  GetIDsOfNames.i 
  Invoke.i
EndStructure 

Structure DispatchObject 
  *dispatchFunctions.DispatchFunctions 
  ObjectCount.l 
EndStructure 

Procedure.l AddRef(*THIS.DispatchObject) 
  *THIS\ObjectCount + 1 
  ProcedureReturn *THIS\ObjectCount 
EndProcedure 

Procedure.l QueryInterface(*THIS.DispatchObject, *IID.GUID, *Object.INTEGER) 
  If CompareMemory(*IID, ?IID_IUnknown, SizeOf(GUID)) Or CompareMemory(*IID, ?IID_IDispatch, SizeOf(GUID)) 
    *Object\i = *THIS 
    AddRef(*THIS.DispatchObject) 
    ProcedureReturn #S_OK 
    Else : *Object\i = 0 : ProcedureReturn #E_NOINTERFACE : EndIf 
EndProcedure 

Procedure.l Release(*THIS.DispatchObject) 
  *THIS\ObjectCount - 1 
  ProcedureReturn *THIS\ObjectCount 
EndProcedure 

Procedure GetTypeInfoCount(*THIS.DispatchObject, pctinfo) : EndProcedure 

Procedure GetTypeInfo(*THIS.DispatchObject, itinfo, lcid, pptinfo ) : EndProcedure 

Procedure GetIDsOfNames(*THIS.DispatchObject, riid, rgszNames, cNames, lcid, rgdispid) : EndProcedure 

Procedure Invoke(*THIS.DispatchObject, dispIdMember, riid, lcid, wFlags, *pDispParams.DISPPARAMS, pVarResult, pExcepInfo, puArgErr) 
  ; Debug "fired " + Str(Random(1000))
  If dispIdMember = #DISPID_DOWNLOADCOMPLETE 
    Debug "YES!" 
    
  ElseIf dispIdMember = #DISPID_NEWWINDOW3 
    Debug "NewWindow3" 
    Debug "numargs: "+Str(*pDispParams\cArgs) 
    *params.VARIANT = *pDispParams\rgvarg 
    *params2.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*5) 
    *params3.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*4) 
    *params4.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*3) 
    *params5.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*2) 
    *params6.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*1) 
    *params7.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*0) 
    
    hResult.l = #S_OK 
    Dim argument.s(1) 
    Define.VARIANT TmpArg 
    For Index.l = 0 To 1 
      VariantInit_(@TmpArg) 
      If VariantChangeType_(@TmpArg, *pDispParams\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 
    Debug argument(Index-1)
   
      ElseIf dispIdMember = #DISPID_NAVIGATEERROR 
    Debug "NavigateError" 
    *params1.VARIANT = *pDispParams\rgvarg
    *params2.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*5) 
    *params3.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*4) 
    *params4.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*3) 
    *params5.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*2) 
    *params6.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*1) 
    
    ;     If  *params2\vt = 8 ;#VT_BSTR 
    ;                         ;         Debug PeekL(*Url\bstrval-4) 
    ;       Debug *params4\bstrval 
    ;     EndIf 
    Debug PeekS(*params3\bstrval,-1,#PB_Unicode)  ;;; trying to get the URL 
    ;;; not quite there yet
                                                

    
  ElseIf dispIdMember = #DISPID_DOCUMENTCOMPLETE 
    Debug "Document Complete" 
  EndIf 
EndProcedure 

dispatchFunctions.DispatchFunctions\QueryInterface   = @QueryInterface() 
dispatchFunctions.DispatchFunctions\AddRef           = @AddRef() 
dispatchFunctions.DispatchFunctions\Release          = @Release() 
dispatchFunctions.DispatchFunctions\GetTypeInfoCount = @GetTypeInfoCount() 
dispatchFunctions.DispatchFunctions\GetTypeInfo      = @GetTypeInfo() 
dispatchFunctions.DispatchFunctions\GetIDsOfNames    = @GetIDsOfNames() 
dispatchFunctions.DispatchFunctions\Invoke           = @Invoke() 

dispatchObject.DispatchObject\dispatchFunctions = dispatchFunctions 

;Declare an instance 
Dispatch.IDispatch = @dispatchObject 

;--------------------------------------------------------------------------------------------- 

OpenWindow(0,0,0,640,480,"Test",#PB_Window_SystemMenu | #PB_Window_ScreenCentered) 
CreateGadgetList(WindowID(0)) 
WebGadget(0,0,0,640,480, "https://www.google.com/nonexistentpage") 
; SetGadgetAttribute(0, #PB_Web_BlockPopups, 1) 

WebBrowser.IWebBrowser2 = GetWindowLong_(GadgetID(0), #GWL_USERDATA) 
WebBrowser\QueryInterface(?IID_IConnectionPointContainer, @connectionPointContainer.IConnectionPointContainer) 
connectionPointContainer\FindConnectionPoint(?IID_DWebBrowserEvents2, @connectionPoint.IConnectionPoint) 


connectionPoint\Advise(Dispatch, @Cookie) 

Repeat 
Until WaitWindowEvent() = #PB_Event_CloseWindow 
WebBrowser\Release()
End 

DataSection 

  IID_IConnectionPointContainer: 
  Data.l $B196B284 
  Data.w $BAB4, $101A 
  Data.b $B6, $9C, $00, $AA, $00, $34, $1D, $07    
  
  IID_IDispatch: 
  Data.l $00020400 
  Data.w $0000, $0000 
  Data.b $C0, $00, $00, $00, $00, $00, $00, $46 
  
  IID_IUnknown: 
  Data.l $00000000 
  Data.w $0000, $0000 
  Data.b $C0, $00, $00, $00, $00, $00, $00, $46 
  
  IID_DWebBrowserEvents2: 
  Data.l $34A715A0 
  Data.w $6587, $11D0 
  Data.b $92, $4A, $00, $20, $AF, $C7, $AC, $4D 
EndDataSection

JHPJHP · Post by **JHPJHP** » Fri Jan 04, 2019 12:54 am

Hi firace,

See the following post by Nico: viewtopic.php?p=202464#p202464

Code: Select all

;- Implementation af the IDispatch interface 
; Original code posted by soerenkj
; Completed by Nico

Line 213: Remove .l
Line 234: Remove .l
Line 241: Remove .l
Line 288: ;REM Line
Line 469: ;REM Line (depreciated)
Line 470: Change URL (optional)

firace · Post by **firace** » Fri Jan 04, 2019 8:38 am

Great link, many thanks JHPJHP

mk-soft · Post by **mk-soft** » Fri Jan 04, 2019 5:46 pm

rgvarg is a array of variant

Code: Select all

Structure udtArgs
  Value.Variant[0]
EndStructure
  
Procedure Invoke(*This.objRuntime, DispId.l, *iid.IID, lcid.l, Flags.w, *DispParams.DISPPARAMS, *vResult.VARIANT, *ExcepInfo.EXCEPINFO, *ArgErr.Integer)
    
  Protected *vArg.udtArgs, r1, name.s, value.variant
    
  *vArg = *DispParams\rgvarg
  
  ; ...
  
EndProcedure

Show module "ActiveScript" or "BaseClassDispatch"

viewtopic.php?f=12&t=71399

Nico · Post by **Nico** » Fri Jan 04, 2019 6:34 pm

Update example for PB 5.70:

Code: Select all

;- Implementation af the IDispatch interface
; Original code posted by soerenkj
; Completed by Nico
; Update for PB 5.70 x32 x64
; 
;//
;// Dispatch IDS For IExplorer Dispatch Events.
;//
#DISPID_BEFORENAVIGATE=     100   ;// this is sent before navigation To give a chance To abort
#DISPID_NAVIGATECOMPLETE=   101   ;// in async, this is sent when we have enough To show
#DISPID_STATUSTEXTCHANGE=   102
#DISPID_QUIT=               103
#DISPID_DOWNLOADCOMPLETE=   104
#DISPID_COMMANDSTATECHANGE= 105
#DISPID_DOWNLOADBEGIN=      106
#DISPID_NEWWINDOW=          107   ;// sent when a new window should be created
#DISPID_PROGRESSCHANGE=     108   ;// sent when download progress is updated
#DISPID_WINDOWMOVE=         109   ;// sent when main window has been moved
#DISPID_WINDOWRESIZE=       110   ;// sent when main window has been sized
#DISPID_WINDOWACTIVATE=     111   ;// sent when main window has been activated
#DISPID_PROPERTYCHANGE=     112   ;// sent when the PutProperty method is called
#DISPID_TITLECHANGE=        113   ;// sent when the document title changes
#DISPID_TITLEICONCHANGE=    114   ;// sent when the top level window icon may have changed.

#DISPID_FRAMEBEFORENAVIGATE=    200
#DISPID_FRAMENAVIGATECOMPLETE=  201
#DISPID_FRAMENEWWINDOW=         204

#DISPID_PRINTTEMPLATEINSTANTIATION= 225
#DISPID_PRINTTEMPLATETEARDOWN=      226

#DISPID_BEFORENAVIGATE2=      250   ;// hyperlink clicked on
#DISPID_NEWWINDOW2=           251
#DISPID_NAVIGATECOMPLETE2=    252   ;// UIActivate new document
#DISPID_ONQUIT=               253
#DISPID_ONVISIBLE=            254   ;// sent when the window goes visible/hidden
#DISPID_ONTOOLBAR=            255   ;// sent when the toolbar should be shown/hidden
#DISPID_ONMENUBAR=            256   ;// sent when the menubar should be shown/hidden
#DISPID_ONSTATUSBAR=          257   ;// sent when the statusbar should be shown/hidden
#DISPID_ONFULLSCREEN=         258   ;// sent when kiosk mode should be on/off
#DISPID_DOCUMENTCOMPLETE=     259   ;// new document goes ReadyState_Complete
#DISPID_ONTHEATERMODE=        260   ;// sent when theater mode should be on/off
#DISPID_ONADDRESSBAR=         261   ;// sent when the address bar should be shown/hidden
#DISPID_WINDOWSETRESIZABLE=   262   ;// sent To set the style of the host window frame
#DISPID_WINDOWCLOSING=        263   ;// sent before script window.close closes the window
#DISPID_WINDOWSETLEFT=        264   ;// sent when the put_left method is called on the WebOC
#DISPID_WINDOWSETTOP=         265   ;// sent when the put_top method is called on the WebOC
#DISPID_WINDOWSETWIDTH=       266   ;// sent when the put_width method is called on the WebOC
#DISPID_WINDOWSETHEIGHT=      267   ;// sent when the put_height method is called on the WebOC
#DISPID_CLIENTTOHOSTWINDOW=   268   ;// sent during window.open To request conversion of dimensions
#DISPID_SETSECURELOCKICON=    269   ;// sent To suggest the appropriate security icon To show
#DISPID_FILEDOWNLOAD=         270   ;// Fired To indicate the File Download dialog is opening
#DISPID_NAVIGATEERROR=        271   ;// Fired To indicate the a binding error has occured
#DISPID_PRIVACYIMPACTEDSTATECHANGE=   272  ;// Fired when the user's browsing experience is impacted
#DISPID_NEWWINDOW3=           273


Structure DispatchFunctions
    QueryInterface.i
    AddRef.i
    Release.i
    GetTypeInfoCount.i
    GetTypeInfo.i
    GetIDsOfNames.i
    Invoke.i
EndStructure

Structure DispatchObject
    *IDispatch.IDispatch
    ObjectCount.l
    GadgetID.i
EndStructure

Global NewList dispatchObject.DispatchObject()

Procedure BeforeNavigate2(*THIS.DispatchObject,*pDisp.Idispatch, *Url.Variant, *Flags.Variant, *TargetFrameName.Variant, *PostData.Variant, *Headers.Variant, *Cancel.long)
    Debug "----------------------------------------------"
    Debug "BeforeNavigate2"
    Debug PeekL(*Url\bstrval-4)
    Debug PeekS(*Url\bstrval,-1,#PB_Unicode)
EndProcedure

Procedure ClientToHostWindow(*THIS.DispatchObject,*CX.LONG, *CY.LONG)
    Debug "----------------------------------------------"
    Debug "ClientToHostWindow"
    Debug *CX\l
    Debug *CY\l
EndProcedure

Procedure CommandStateChange(*THIS.DispatchObject,Command.l, Enable.l)
    Debug "----------------------------------------------"
    ;Valeur pour la Variable Command
    ;     #CSC_UPDATECOMMANDS = $FFFFFFFF
    ;     #CSC_NAVIGATEFORWARD = $00000001
    ;     #CSC_NAVIGATEBACK = $00000002
    Debug "CommandStateChange"
    Debug Command
    Debug Enable
EndProcedure

Procedure DocumentComplete(*THIS.DispatchObject,*pDisp.IDispatch, *URL.Variant)
    Debug "----------------------------------------------"
    Debug "DocumentComplete"
    Debug PeekL(*Url\bstrval-4)
    Debug PeekS(*Url\bstrval,-1,#PB_Unicode)
EndProcedure

Procedure DownloadComplete(*THIS.DispatchObject)
    Debug "----------------------------------------------"
    Debug "DownloadComplete"
EndProcedure

Procedure DownloadBegin(*THIS.DispatchObject)
    Debug "----------------------------------------------"
    Debug "DownloadBegin"
EndProcedure

Procedure FileDownload(*THIS.DispatchObject,bActiveDocument.l, *bCancel.LONG)
    Debug "----------------------------------------------"
    Debug "FileDownload"
    Debug bActiveDocument
    Debug *bCancel\l
EndProcedure

Procedure NavigateComplete2(*THIS.DispatchObject,*pDisp.IDispatch, *URL.Variant)
    Debug "----------------------------------------------"
    Debug "NavigateComplete2"
    If  *Url\vt = 8 ;#VT_BSTR
        Debug PeekL(*Url\bstrval-4)
        Debug PeekS(*Url\bstrval,-1,#PB_Unicode)
    EndIf
EndProcedure

Procedure NavigateError(*THIS.DispatchObject,*pDisp.IDispatch, *URL.Variant, *TargetFrameName.Variant, *StatusCode.Variant, *Cancel.LONG)
    Debug "----------------------------------------------"
    Debug "NavigateError"
    If  *Url\vt = 8 ;#VT_BSTR
        Debug PeekL(*Url\bstrval-4)
        Debug PeekS(*Url\bstrval,-1,#PB_Unicode)
    EndIf
EndProcedure

Procedure NewWindow2(*THIS.DispatchObject,*ppDisp.LONG, *Cancel.LONG)
    Protected X.l,Y.l,Width.l,Height.l,ID.l,Disp.l
    Debug "----------------------------------------------"
    Debug "NewWindow2"
    
    ; On récupère les coordonnées du WebGadget actuel
    X=GadgetX(*THIS\GadgetID)
    Y=GadgetY(*THIS\GadgetID)
    Width=GadgetWidth(*THIS\GadgetID)
    Height=GadgetHeight(*THIS\GadgetID)
    
    ; On cache le WebGadget actuel
    HideGadget(*THIS\GadgetID,1)
    
    ; On crée un nouveau WebGadget avec les coordonnées récupérées
    OpenGadgetList(0,0)
    ID=WebGadget(#PB_Any,X,Y,Width,Height,"About:Blank")
    CloseGadgetList()
    
    ; On récupère l'interface IWebBrowser2 du nouveau WebGadget
    WebBrowser.IWebBrowser2 = GetWindowLong_(GadgetID(ID), #GWL_USERDATA)
    ; On récupère l'interface Idispatch
    Webbrowser\Get_Application(@Disp)
    ; On affecte l'interface Idispactch du WebGadget créé au paramètre *ppDisp
    *ppDisp\l=Disp
    
    ; On détruit l'élément courant
    DeleteElement(DispatchObject())
    
    ; On détruit l'ancien WebGadget
    FreeGadget(*THIS\GadgetID)
    
    ; On ajoute à la liste le nouveau WebGadget créé
    AddElement(DispatchObject())
    DispatchObject()\IDispatch = ?dispatchFunctions
    DispatchObject()\GadgetID=ID
    
    ; On crée un point de connexion sur l'interface IDispatch
    WebBrowser\QueryInterface(?IID_IConnectionPointContainer, @connectionPointContainer.IConnectionPointContainer)
    connectionPointContainer\findconnectionpoint(?IID_DWebBrowserEvents2, @connectionPoint.IConnectionPoint)
    connectionPoint\Advise(DispatchObject(), @Cookie)
    connectionPoint\release()
    connectionPointContainer\release()
    
EndProcedure

Procedure NewWindow3(*ppDisp.LONG, *Cancel.LONG, dwFlags.l, *bstrUrlContext, *bstrUrl)
    Debug "NewWindow3"
    Debug PeekS(*bstrUrl,-1,#PB_Unicode)
    Nouvelle_url.s= PeekS(*bstrUrl,-1,#PB_Unicode)
    SetGadgetText(0,Nouvelle_url); your webgadget
    *Cancel\l=1
EndProcedure


Procedure OnFullScreen(*THIS.DispatchObject,FullScreen.l)
    Debug "----------------------------------------------"
    Debug "OnFullScreen"
    Debug FullScreen
EndProcedure

Procedure OnMenuBar(*THIS.DispatchObject,MenuBar.l)
    Debug "----------------------------------------------"
    Debug "OnMenuBar"
    Debug "MenuBar"
EndProcedure

Procedure OnQuit(*THIS)
    Debug "----------------------------------------------"
    Debug "OnQuit"
EndProcedure

Procedure OnStatusBar(*THIS.DispatchObject,StatusBar.l)
    Debug "----------------------------------------------"
    Debug "OnStatusBar"
    Debug "StatusBar"
EndProcedure

Procedure OnTheaterMode(*THIS.DispatchObject,TheaterMode.l)
    Debug "----------------------------------------------"
    Debug "OnTheaterMode"
EndProcedure

Procedure OnToolBar(*THIS.DispatchObject,ToolBar.l)
    Debug "----------------------------------------------"
    Debug "OnToolBar"
    Debug "ToolBar"
EndProcedure

Procedure OnVisible(*THIS.DispatchObject,vVisible.l)
    Debug "----------------------------------------------"
    Debug "OnVisible"
    Debug "vVisible"
EndProcedure

Procedure  PrintTemplateInstantiation(*THIS.DispatchObject,*pDisp.IDispatch)
    Debug "----------------------------------------------"
    ;PrintTemplateInstantiation was introduced in Microsoft Internet Explorer 6
    Debug "PrintTemplateInstantiation"
    
EndProcedure

Procedure PrintTemplateTeardown(*THIS.DispatchObject,*pDisp.IDispatch)
    Debug "----------------------------------------------"
    ;PrintTemplateTeardown was introduced in Microsoft Internet Explorer 6
    Debug "PrintTemplateTeardown"
EndProcedure

Procedure PrivacyImpactedStateChange(*THIS.DispatchObject,bPrivacyImpacted.l)
    Debug "----------------------------------------------"
    Debug "bPrivacyImpacted"
    Debug bPrivacyImpacted
EndProcedure

Procedure ProgressChange(*THIS.DispatchObject,nProgress.l, nProgressMax.l)
    Protected Progress.l
    Debug "----------------------------------------------"
    Debug "ProgressChange"
    Debug nProgress
    Debug nProgressMax
    If nProgressMax>0
        Progress=nProgress*100/nProgressMax
        SetGadgetState(2, Progress)
    Else
        SetGadgetState(2, 0)
    EndIf
EndProcedure

Procedure PropertyChange(*THIS.DispatchObject,*sProperty)
    Debug "----------------------------------------------"
    Debug "PropertyChange"
    Debug PeekL(*sProperty-4)
    Debug PeekS(*sProperty,-1,#PB_Unicode)
EndProcedure

Procedure SetSecureLockIcon(*THIS.DispatchObject,SecureLockIcon.l)
    Debug "----------------------------------------------"
    ;     SecureLockIcon Constants
    ;     secureLockIconUnsecure = 0
    ;     secureLockIconMixed = 1
    ;     secureLockIconSecureUnknownBits = 2
    ;     secureLockIconSecure40Bit = 3
    ;     secureLockIconSecure56Bit = 4
    ;     secureLockIconSecureFortezza = 5
    ;     secureLockIconSecure128Bit = 6
    Debug "SetSecureLockIcon"
    Debug SecureLockIcon
EndProcedure

Procedure StatusTextChange(*THIS.DispatchObject,*sText)
    Protected Texte.s
    ;     Debug "----------------------------------------------"
    ;     Debug "StatusTextChange"
    ;     Debug PeekL(*sText-4)
    
    Texte.s= PeekS(*sText,-1,#PB_Unicode)
    StatusBarText(0, 0, Texte)
EndProcedure

Procedure TitleChange(*THIS.DispatchObject,*sText)
    Protected Texte.s
    ;     Debug "----------------------------------------------"
    ;     Debug "TitleChange"
    ;     Debug PeekL(*sText-4)
    Texte=PeekS(*sText,-1,#PB_Unicode)
    element=GetGadgetState(0)
    SetGadgetItemText(0, element, Texte, 0)
EndProcedure


Procedure WindowClosing(*THIS.DispatchObject,bIsChildWindow.l, *Cancel.LONG)
    Debug "----------------------------------------------"
    Debug "WindowClosing"
    Debug bIsChildWindow
EndProcedure

Procedure WindowSetLeft(*THIS.DispatchObject,nLeft.l)
    Debug "----------------------------------------------"
    Debug "WindoSetLeft"
EndProcedure

Procedure WindowSetTop(*THIS.DispatchObject,nTop.l)
    Debug "----------------------------------------------"
    Debug "WindoSetTop"
EndProcedure

Procedure WindowSetWidth(*THIS.DispatchObject,nWidth.l)
    Debug "----------------------------------------------"
    Debug "WindoSetTop"
EndProcedure

Procedure WindowSetHeight(*THIS.DispatchObject,nHeight.l)
    Debug "----------------------------------------------"
    Debug "WindoSetHeight"
EndProcedure

Procedure WindowSetResizable(*THIS.DispatchObject,bResizable.l)
    Debug "----------------------------------------------"
    Debug "WindowSetResizable"
    Debug bResizable
EndProcedure

Procedure.l AddRef(*THIS.DispatchObject)
    *THIS\ObjectCount + 1
    ProcedureReturn *THIS\ObjectCount
EndProcedure

Procedure.l QueryInterface(*THIS.DispatchObject, *iid.GUID, *Object.LONG)
    
    ;     If CompareMemory(*iid,?IID_DWebBrowserEvents2,16)
    ;        ; CallDebugger
    ;     EndIf
    
    If CompareMemory(*iid, ?IID_IUnknown, SizeOf(GUID)) Or CompareMemory(*iid, ?IID_IDispatch, SizeOf(GUID))
        *Object\l = *THIS
        AddRef(*THIS.DispatchObject)
        
        ProcedureReturn #S_OK
    Else
        *Object\l = 0
        ProcedureReturn #E_NOINTERFACE
    EndIf
EndProcedure

Procedure.l Release(*THIS.DispatchObject)
    *THIS\ObjectCount - 1
    ProcedureReturn *THIS\ObjectCount
EndProcedure

Procedure GetTypeInfoCount(*THIS.DispatchObject, pctinfo)
    ProcedureReturn #E_NOTIMPL
EndProcedure

Procedure GetTypeInfo(*THIS.DispatchObject, iTInfo, lcid, ppTInfo )
    ProcedureReturn #E_NOTIMPL
EndProcedure

Procedure GetIDsOfNames(*THIS.DispatchObject, riid, rgszNames, cNames, lcid, rgDispId) : EndProcedure

Procedure Invoke(*THIS.DispatchObject, dispIdMember, riid, lcid, wFlags, *pDispParams.DISPPARAMS, pVarResult, pExcepInfo, puArgErr)
    
    Select dispIDMember
        Case #DISPID_BEFORENAVIGATE2
            *params1.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*6)
            *params2.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*5)
            *params3.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*4)
            *params4.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*3)
            *params5.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*2)
            *params6.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*1)
            *params7.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*0)
            BeforeNavigate2(*THIS,*params1\pdispVal,*params2\pvarVal,*params3\pvarVal,*params4\pvarVal,*params5\pvarVal,*params6\pvarVal,*params2\pboolVal)
            
        Case #DISPID_CLIENTTOHOSTWINDOW
            *params1.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*1)
            *params2.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*0)
            ClientToHostWindow(*THIS,*params1\plVal, *params2\plVal)
            
        Case #DISPID_COMMANDSTATECHANGE
            *params1.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*1)
            *params2.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*0)
            CommandStateChange(*THIS,*params1\lVal, *params2\boolVal)
            
        Case #DISPID_DOCUMENTCOMPLETE
            *params1.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*1)
            *params2.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*0)
            DocumentComplete(*THIS,*params1\pDispVal, *params2\pvarVal)
            
        Case #DISPID_DOWNLOADBEGIN
            DownloadBegin(*THIS)
            
        Case #DISPID_DOWNLOADCOMPLETE
            DownloadComplete(*THIS)
            
        Case #DISPID_FILEDOWNLOAD
            *params1.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*1)
            *params2.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*0)
            FileDownload(*THIS,*params1\pBoolVal, *params2\pBoolVal)
            
        Case #DISPID_NAVIGATECOMPLETE2
            *params1.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*1)
            *params2.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*0)
            NavigateComplete2(*THIS,*params1\pDispVal, *params2\pvarVal)
            
        Case #DISPID_NAVIGATEERROR
            *params1.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*4)
            *params2.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*3)
            *params3.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*2)
            *params4.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*1)
            *params5.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*0)
            NavigateError(*THIS,*params1\pdispVal, *params2\pvarVal, *params3\pvarVal, *params4\pvarVal, *params5\pboolVal)
            
            ;         Case #DISPID_NEWWINDOW2
            ;             *params1.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*1)
            ;             *params2.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*0)
            ;             NewWindow2(*THIS,*params1\ppdispVal, *params2\pboolVal)
            
        Case #DISPID_NEWWINDOW3
            *params1.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*4)
            *params2.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*3)
            *params3.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*2)
            *params4.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*1)
            *params5.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*0)
            NewWindow3(*params1\ppdispVal, *params2\pboolVal, *params3\lVal, *params4\bstrVal, *params5\bstrVal)
            
        Case #DISPID_ONFULLSCREEN
            *params.VARIANT = *pDispParams\rgvarg
            OnFullScreen(*THIS,*params\boolVal)
            
        Case #DISPID_ONMENUBAR
            *params.VARIANT = *pDispParams\rgvarg
            OnMenuBar(*THIS,*params\boolVal)
            
        Case #DISPID_ONQUIT
            OnQuit(*THIS)
            
        Case #DISPID_ONSTATUSBAR
            *params.VARIANT = *pDispParams\rgvarg
            OnStatusBar(*THIS,*params\boolVal)
            
        Case #DISPID_ONTHEATERMODE
            *params1.VARIANT = *pDispParams\rgvarg
            OnTheaterMode(*THIS,*params1\boolVal)
            
        Case #DISPID_ONTOOLBAR
            *params.VARIANT = *pDispParams\rgvarg
            OnToolbar(*THIS,*params\boolVal)
            
        Case #DISPID_ONVISIBLE
            *params.VARIANT = *pDispParams\rgvarg
            OnVisible(*THIS,*params\boolVal)
            
        Case #DISPID_PRINTTEMPLATEINSTANTIATION
            *params.VARIANT = *pDispParams\rgvarg
            PrintTemplateInstantiation(*THIS,*params\pdispVal)
            
        Case #DISPID_PRINTTEMPLATETEARDOWN
            *params.VARIANT = *pDispParams\rgvarg
            PrintTemplateTeardown(*THIS,*params\pdispVal)
            
        Case #DISPID_PRIVACYIMPACTEDSTATECHANGE
            *params.VARIANT = *pDispParams\rgvarg
            PrivacyImpactedStateChange(*THIS,*params\boolVal)
            
        Case #DISPID_PROGRESSCHANGE
            *params1.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*1)
            *params2.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*0)
            ProgressChange(*THIS,*params1\lVal, *params2\lVal)
            
        Case #DISPID_PROPERTYCHANGE
            *params.VARIANT = *pDispParams\rgvarg
            PropertyChange(*THIS,*params\bstrVal)
            
        Case #DISPID_SETSECURELOCKICON
            *params.VARIANT = *pDispParams\rgvarg
            SetSecureLockIcon(*THIS,*params\lVal)
            
        Case #DISPID_STATUSTEXTCHANGE
            *params.VARIANT = *pDispParams\rgvarg
            StatusTextChange(*THIS,*params\bstrval)
            
        Case #DISPID_TITLECHANGE
            *params.VARIANT = *pDispParams\rgvarg
            TitleChange(*THIS,*params\bstrVal)
            
        Case #DISPID_WINDOWCLOSING
            *params1.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*1)
            *params2.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*0)
            WindowClosing(*THIS,*params1\boolVal, *params2\pboolVal)
            
        Case #DISPID_WINDOWSETLEFT
            *params.VARIANT = *pDispParams\rgvarg
            WindowSetLeft(*THIS,*params\lVal)
            
        Case #DISPID_WINDOWSETTOP
            *params.VARIANT = *pDispParams\rgvarg
            WindowSetTop(*THIS,*params\lVal)
            
        Case #DISPID_WINDOWSETWIDTH
            *params.VARIANT = *pDispParams\rgvarg
            WindowSetWidth(*THIS,*params\lVal)
            
        Case #DISPID_WINDOWSETHEIGHT
            *params.VARIANT = *pDispParams\rgvarg
            WindowSetHeight(*THIS,*params\lVal)
            
        Case #DISPID_WINDOWSETRESIZABLE
            *params.VARIANT = *pDispParams\rgvarg
            WindowSetResizable(*THIS,*params\boolVal)
    EndSelect
EndProcedure


;---------------------------------------------------------------------------------------------

If OpenWindow(0,0,0,640,520,"Test",#PB_Window_SystemMenu | #PB_Window_ScreenCentered)
    If CreateStatusBar(0, WindowID(0))
        AddStatusBarField(300)
        AddStatusBarField(300)
    EndIf
    
    StatusBarText(0, 0, "")
    StatusBarText(0, 1, "")
    
    PanelGadget(0, 10, 50, 620, 420)
    AddGadgetItem (0, -1, "")
    WebGadget(1,10,10,600,380, "https://www.purebasic.fr")
    WebGadget(10,10,10,600,380, "About:blank")
    CloseGadgetList()
    
    ProgressBarGadget(2,  10, 10, 200,  20, 0, 100)
    
    AddElement(DispatchObject())
    DispatchObject()\IDispatch = ?dispatchFunctions
    DispatchObject()\GadgetID=1
    webBrowser.IWebBrowser2 = GetWindowLongPtr_(GadgetID(1), #GWLP_USERDATA)

    webBrowser\QueryInterface(?IID_IConnectionPointContainer, @connectionPointContainer.IConnectionPointContainer)
    If connectionPointContainer
        connectionPointContainer\findconnectionpoint(?IID_DWebBrowserEvents2, @connectionPoint.IConnectionPoint)
        If connectionPoint
            connectionPoint\Advise(DispatchObject(), @Cookie)
            connectionPoint\release()
        EndIf 
        connectionPointContainer\release()
    EndIf
    
    Repeat
    Until WaitWindowEvent() = #PB_Event_CloseWindow
EndIf 
End

DataSection
    dispatchFunctions:
    Data.i @QueryInterface(),@AddRef(),@Release(),@GetTypeInfoCount()
    Data.i @GetTypeInfo(),@GetIDsOfNames(),@Invoke()
    
    IID_IWebBrowser2:
    Data.l $D30C1661
    Data.w $CDAF, $11D0
    Data.b $8A, $3E, $00, $C0, $4F, $C9, $E2, $6E
    
    IID_IConnectionPointContainer:
    Data.l $B196B284
    Data.w $BAB4, $101A
    Data.b $B6, $9C, $00, $AA, $00, $34, $1D, $07   
    
    IID_IDispatch:
    Data.l $00020400
    Data.w $0000, $0000
    Data.b $C0, $00, $00, $00, $00, $00, $00, $46
    
    IID_IUnknown:
    Data.l $00000000
    Data.w $0000, $0000
    Data.b $C0, $00, $00, $00, $00, $00, $00, $46
    
    IID_DWebBrowserEvents2:
    Data.l $34A715A0
    Data.w $6587, $11D0
    Data.b $92, $4A, $00, $20, $AF, $C7, $AC, $4D
EndDataSection

PureBasic Forums - English

WebGadget (Windows) and VARIANT parameter

WebGadget (Windows) and VARIANT parameter

Re: WebGadget (Windows) and VARIANT parameter

Re: WebGadget (Windows) and VARIANT parameter

Re: WebGadget (Windows) and VARIANT parameter

Re: WebGadget (Windows) and VARIANT parameter