WebGadget DocumentComplete event

Just starting out? Need help? Post your questions and find answers here.
Post Reply
Sparkie
PureBatMan Forever
PureBatMan Forever
Posts: 2307
Joined: Tue Feb 10, 2004 3:07 am
Location: Ohio, USA

Post by Sparkie »

Thanks soerenkj, I'll take a look and see if it opens my eyes. ;)
What goes around comes around.

PB 5.21 LTS (x86) - Windows 8.1
Top
soerenkj
User
User
Posts: 95
Joined: Mon Jun 14, 2004 10:19 pm

Post by soerenkj »

I'm getting closer! as you can see I am able to receive an event from the WebGadget (!!), but after that it crashes... why?!?

Code: Select all

;- Implementation af the IDispatch interface --------------------------------------------------

Structure DispatchFunctions 
  QueryInterface.l 
  AddRef.l 
  Release.l
  GetTypeInfoCount.l
  GetTypeInfo.l
  GetIDsOfNames.l
  Invoke.l
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.LONG)
  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(pctinfo) : EndProcedure

Procedure GetTypeInfo(iTInfo, lcid, ppTInfo ) : EndProcedure

Procedure GetIDsOfNames(riid, rgszNames, cNames, lcid, rgDispId) : EndProcedure

Procedure Invoke(dispIdMember, riid, lcid, wFlags, pDispParams, pVarResult, pExcepInfo, puArgErr)
  Debug "got an event!!! (I think)"
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,300,300,#PB_Window_ScreenCentered,"Test")
CreateGadgetList(WindowID(0))
WebGadget(0,0,0,300,300, "purebasic.com")
webBrowser.IWebBrowser2 = GetWindowLong_(GadgetID(0), #GWL_USERDATA)
webBrowser\QueryInterface(?IID_IConnectionPointContainer, @connectionPointContainer.IConnectionPointContainer) 
connectionPointContainer\FindConnectionPoint(?IID_IDispatch, @connectionPoint.IConnectionPoint)

;Tell the webBrowser of the connectionpoint, that it should call my implementation of 
;the Idispatch object when firing events
connectionPoint\Advise(dispatch, @Cookie)

End 

DataSection 
   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 
EndDataSection
References
viewtopic.php?t=8538&highlight=interface+objects
viewtopic.php?t=12133

(Sparkie, no variant seemed to be necessary..!?)
Top
pantsonhead
User
User
Posts: 39
Joined: Fri Mar 26, 2004 1:47 pm
Location: London, UK
Contact:
Contact pantsonhead

Post by pantsonhead »

Any more progress on this? Looks promising.
Top
soerenkj
User
User
Posts: 95
Joined: Mon Jun 14, 2004 10:19 pm

Post by soerenkj »

sorry, I haven't had the time to work so much on it
was hoping someone could give a hand...
(right now I have a project with a higher prority)
Top
soerenkj
User
User
Posts: 95
Joined: Mon Jun 14, 2004 10:19 pm

Post by soerenkj »

i found the problem! I just forgot to give Invoke the first parameter *THIS.DispatchObject. You'll never believe how much time I spent browsing documentation until I noticed this...

Code: Select all

#DISPID_DOWNLOADCOMPLETE   = 104

;- Implementation af the IDispatch interface --------------------------------------------------

Structure DispatchFunctions
  QueryInterface.l
  AddRef.l
  Release.l
  GetTypeInfoCount.l
  GetTypeInfo.l
  GetIDsOfNames.l
  Invoke.l
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.LONG)
  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) : 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, pVarResult, pExcepInfo, puArgErr)
  If dispIDMember = #DISPID_DOWNLOADCOMPLETE
    Debug "YES!"
  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,300,300,#PB_Window_ScreenCentered,"Test")
CreateGadgetList(WindowID(0))
WebGadget(0,0,0,300,300, "purebasic.com")
webBrowser.IWebBrowser2 = GetWindowLong_(GadgetID(0), #GWL_USERDATA)
webBrowser\QueryInterface(?IID_IConnectionPointContainer, @connectionPointContainer.IConnectionPointContainer)
connectionPointContainer\FindConnectionPoint(?IID_IDispatch, @connectionPoint.IConnectionPoint)

;Tell the webBrowser of the connectionpoint, that it should call my implementation of
;the Idispatch object when firing events
connectionPoint\Advise(dispatch, @Cookie)

Repeat
Until WaitWindowEvent() = #PB_Event_CloseWindow

End

DataSection
   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
EndDataSection
Top
tms
New User
New User
Posts: 9
Joined: Wed Jul 09, 2003 7:02 pm
Location: Germany

Post by tms »

soerenkj wrote: "You'll never believe how much time I spent browsing documentation until I noticed this..."

:) I BELIEVE!!!! :)
Thank's for your hard work. This REALLY :!: helps a lot.
tms
Top
soerenkj
User
User
Posts: 95
Joined: Mon Jun 14, 2004 10:19 pm

Post by soerenkj »

no problem. btw I just found out about the 'COMEvents' user library which will handle this problem also (it's on purearea.net). too bad I did not notice that earlier..
Top
krensauce
User
User
Posts: 18
Joined: Sun Nov 05, 2006 10:24 pm

Post by krensauce »

soerenkj wrote:no problem. btw I just found out about the 'COMEvents' user library which will handle this problem also (it's on purearea.net). too bad I did not notice that earlier..
Very good job soerenkj!

I was messing with these things too before noticing that lib. That made the job really easy for me.
Unfortunately it doesn't work on PB4, it gives the usual error as other pre-PB4 libs gives.

I thought about reviving this project then, by adding the features of that lib to it (atleast the most useful).

I did a private project using the COMEvents lib, and in the process of converting it to PB4 I found out that problem. So I started looking back at this forum, trying to figure out if I can use some of the sources posted to get rid of the lib and use only PB code to do the job.
I found out that the most clean and readable is your code, and so I started working a bit with it.
I must say that I'm ill now so I can't concentrate at 100% to it, but I got stuck in a point.
I slightly modified it to support the DWebBrowserEvents2 events, which includes a good set of useful events to use for your programs. The fact is that some events aren't simply useful because you can know they fired, but some needs also to set up some data to modify some behavior of the WebGadget.
As an example I show you the NewWindow3 event, which I'm working on, that also have a Cancel variable that you can set to a bool value to either allow a new window to be opened or not (like when clicking on a link and it opens in a new window, or via the menu), and 2 more variables that contains the source URL and the destination URL: link to MSDN page for NewWindow3 event.
I got stuck in the part where you wrote <Debug "YES!"> when your event fired up. I can know when the NewWindow3 event fires, and I also find out that the pDispParams parameter of your Invoke() procedure contains the parameters of the NewWindow3 event (see modified source below), but I don't know neither how to retrieve them from the VARIANT structure nor how to modify them in order to make the event react on the changes.

I did slight modifications to make it work under PB4 and to make it react on DWebBrowserEvents2 events. You can see that the *pDispParams\cArgs structure field contains the number of arguments passed by the fired event, but there's still some work to obtain them and to set them. If the code will work, I will be happy to modify it so it can handle multiple objects (more WebGadgets at once) like the COMEvents lib does, and to add a similar command as the cevBindEvent, to make it easier to add event handling.

Code: Select all

;- Implementation af the IDispatch interface -------------------------------------------------- 

#DISPID_DOWNLOADCOMPLETE   = 104
#DISPID_NEWWINDOW3 = 273
#DISPID_DOCUMENTCOMPLETE = $00000103
#DISPID_FILEDOWNLOAD = $0000010e
#DISPID_PROGRESSCHANGE = $0000006c
#DISPID_BEFORENAVIGATE2 = $000000fa
#DISPID_NEWWINDOW2 = 251

Structure DispatchFunctions 
  QueryInterface.l 
  AddRef.l 
  Release.l 
  GetTypeInfoCount.l 
  GetTypeInfo.l 
  GetIDsOfNames.l 
  Invoke.l 
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.LONG) 
  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) : 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) 
  If dispIDMember = #DISPID_DOWNLOADCOMPLETE 
    Debug "YES!"
   ElseIf dispIDMember = #DISPID_NEWWINDOW3
    Debug "NewWindow3"
    Debug "numargs: "+Str(*pDispParams\cArgs)
    *params.VARIANT = *pDispParams\rgvarg
    ;now I need to be able to access the parameters (which are in the VARIANT structure) and set them to block the NewWindow
   ElseIf dispIDMember = #DISPID_DOCUMENTCOMPLETE
    Debug "Doc 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, "purebasic.com") 
webBrowser.IWebBrowser2 = GetWindowLong_(GadgetID(0), #GWL_USERDATA) 
webBrowser\QueryInterface(?IID_IConnectionPointContainer, @connectionPointContainer.IConnectionPointContainer) 
;connectionPointContainer\FindConnectionPoint(?IID_IDispatch, @connectionPoint.IConnectionPoint)
connectionPointContainer\FindConnectionPoint(?IID_DWebBrowserEvents2, @connectionPoint.IConnectionPoint) 

;Tell the webBrowser of the connectionpoint, that it should call my implementation of 
;the Idispatch object when firing events 
connectionPoint\Advise(dispatch, @Cookie) 

Repeat 
Until WaitWindowEvent() = #PB_Event_CloseWindow 

End 

DataSection 
   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
Top
Nico
Enthusiast
Enthusiast
Posts: 274
Joined: Sun Jan 11, 2004 11:34 am
Location: France

Post by Nico »

Code: Select all

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

;//
;// 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.l
    AddRef.l
    Release.l
    GetTypeInfoCount.l
    GetTypeInfo.l
    GetIDsOfNames.l
    Invoke.l
EndStructure

Structure DispatchObject
    *IDispatch.IDispatch
    ObjectCount.l
EndStructure

Global NewList dispatchObject.DispatchObject()

Procedure BeforeNavigate2(*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(*CX.LONG, *CY.LONG)
    Debug "----------------------------------------------"
    Debug "ClientToHostWindow"
    Debug *CX\l
    Debug *CY\l
EndProcedure 

Procedure CommandStateChange(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(*pDisp.IDispatch, *URL.Variant)
    Debug "----------------------------------------------"
    Debug "DocumentComplete"
    Debug PeekL(*Url\bstrval-4)
    Debug PeekS(*Url\bstrval,-1,#PB_Unicode)
EndProcedure 

Procedure DownloadComplete()
    Debug "----------------------------------------------"
    Debug "DownloadComplete"
EndProcedure 

Procedure DownloadBegin()
    Debug "----------------------------------------------"
    Debug "DownloadBegin"
EndProcedure 

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

Procedure NavigateComplete2(*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(*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(*ppDisp.LONG, *Cancel.LONG)
    Debug "----------------------------------------------"
    Debug "NewWindow2"
    Debug *Cancel\l
EndProcedure 

Procedure OnFullScreen(FullScreen.l)
    Debug "----------------------------------------------"
    Debug "OnFullScreen"
    Debug FullScreen
EndProcedure

Procedure OnMenuBar(MenuBar.l)
    Debug "----------------------------------------------"
    Debug "OnMenuBar"
    Debug "MenuBar"
EndProcedure 

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

Procedure OnStatusBar(StatusBar.l)
    Debug "----------------------------------------------"
    Debug "OnStatusBar"
    Debug "StatusBar"
EndProcedure 

Procedure OnTheaterMode(TheaterMode.l)
    Debug "----------------------------------------------"
    Debug "OnTheaterMode"
EndProcedure 

Procedure OnToolBar(ToolBar.l)
    Debug "----------------------------------------------"
    Debug "OnToolBar"
    Debug "ToolBar"
EndProcedure 

Procedure OnVisible(vVisible.l)
    Debug "----------------------------------------------"
    Debug "OnVisible"
    Debug "vVisible"
EndProcedure 

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

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

Procedure PrivacyImpactedStateChange(bPrivacyImpacted.l)
    Debug "----------------------------------------------"
    Debug "bPrivacyImpacted"
    Debug bPrivacyImpacted
EndProcedure 

Procedure ProgressChange(nProgress.l, nProgressMax.l)
    Debug "----------------------------------------------"
    Debug "ProgressChange"
    Debug nProgress
    Debug nProgressMax
EndProcedure

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

Procedure SetSecureLockIcon(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(*sText.l)
    Debug "----------------------------------------------"
    Debug "StatusTextChange"
    Debug PeekL(*sText-4)
    Debug PeekS(*sText,-1,#PB_Unicode)
EndProcedure 

Procedure TitleChange(*sText.l)
    Debug "----------------------------------------------"
    Debug "TitleChange"
    Debug PeekL(*sText-4)
    Debug PeekS(*sText,-1,#PB_Unicode)
EndProcedure 
                
Procedure WindowClosing(bIsChildWindow.l, *Cancel.LONG)
    Debug "----------------------------------------------"
    Debug "WindowClosing"
    Debug bIsChildWindow
EndProcedure 

Procedure WindowSetLeft(nLeft.l)
    Debug "----------------------------------------------"
    Debug "WindoSetLeft"
EndProcedure

Procedure WindowSetTop(nTop.l)
    Debug "----------------------------------------------"
    Debug "WindoSetTop"
EndProcedure

Procedure WindowSetWidth(nWidth.l)
    Debug "----------------------------------------------"
    Debug "WindoSetTop"
EndProcedure

Procedure WindowSetHeight(nHeight.l)
    Debug "----------------------------------------------"
    Debug "WindoSetHeight"
EndProcedure

Procedure WindowSetResizable(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(*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(*params1\plVal, *params2\plVal)
            
        Case #DISPID_COMMANDSTATECHANGE
            *params1.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*1)
            *params2.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*0)
            CommandStateChange(*params1\lVal, *params2\boolVal)
            
        Case #DISPID_DOCUMENTCOMPLETE
            *params1.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*1)
            *params2.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*0)
            DocumentComplete(*params1\pDispVal, *params2\pvarVal)
            
        Case #DISPID_DOWNLOADBEGIN
            DownloadBegin()
            
        Case #DISPID_DOWNLOADCOMPLETE
            DownloadComplete()
            
        Case #DISPID_FILEDOWNLOAD
            *params1.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*1)
            *params2.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*0)
            FileDownload(*params1\pBoolVal, *params2\pBoolVal)
            
        Case #DISPID_NAVIGATECOMPLETE2
            *params1.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*1)
            *params2.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*0)
            NavigateComplete2(*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(*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(*params1\ppdispVal, *params2\pboolVal)
            
        Case #DISPID_ONFULLSCREEN
            *params.VARIANT = *pDispParams\rgvarg
            OnFullScreen(*params\boolVal)
            
        Case #DISPID_ONMENUBAR
            *params.VARIANT = *pDispParams\rgvarg
            OnMenuBar(*params\boolVal)
            
        Case #DISPID_ONQUIT
            OnQuit()
            
        Case #DISPID_ONSTATUSBAR
            *params.VARIANT = *pDispParams\rgvarg
            OnStatusBar(*params\boolVal)
            
        Case #DISPID_ONTHEATERMODE
            *params1.VARIANT = *pDispParams\rgvarg
            OnTheaterMode(*params1\boolVal)
            
        Case #DISPID_ONTOOLBAR
            *params.VARIANT = *pDispParams\rgvarg
            OnToolbar(*params\boolVal)
            
        Case #DISPID_ONVISIBLE
            *params.VARIANT = *pDispParams\rgvarg
            OnVisible(*params\boolVal)
            
        Case #DISPID_PRINTTEMPLATEINSTANTIATION
            *params.VARIANT = *pDispParams\rgvarg
            PrintTemplateInstantiation(*params\pdispVal)
            
        Case #DISPID_PRINTTEMPLATETEARDOWN
            *params.VARIANT = *pDispParams\rgvarg
            PrintTemplateTeardown(*params\pdispVal)
            
        Case #DISPID_PRIVACYIMPACTEDSTATECHANGE
            *params.VARIANT = *pDispParams\rgvarg
            PrivacyImpactedStateChange(*params\boolVal)
            
        Case #DISPID_PROGRESSCHANGE
            *params1.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*1)
            *params2.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*0)
            ProgressChange(*params1\lVal, *params2\lVal)
            
        Case #DISPID_PROPERTYCHANGE
            *params.VARIANT = *pDispParams\rgvarg
            PropertyChange(*params\bstrVal)
            
        Case #DISPID_SETSECURELOCKICON
            *params.VARIANT = *pDispParams\rgvarg
            SetSecureLockIcon(*params\lVal)
            
        Case #DISPID_STATUSTEXTCHANGE
            *params.VARIANT = *pDispParams\rgvarg
            StatusTextChange(*params\bstrval)
            
        Case #DISPID_TITLECHANGE
            *params.VARIANT = *pDispParams\rgvarg
            TitleChange(*params\bstrVal)
                
        Case #DISPID_WINDOWCLOSING
            *params1.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*1)
            *params2.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*0)
            WindowClosing(*params1\boolVal, *params2\pboolVal)
            
        Case #DISPID_WINDOWSETLEFT
            *params.VARIANT = *pDispParams\rgvarg
            WindowSetLeft(*params\lVal)
            
        Case #DISPID_WINDOWSETTOP
            *params.VARIANT = *pDispParams\rgvarg
            WindowSetTop(*params\lVal)
            
        Case #DISPID_WINDOWSETWIDTH
            *params.VARIANT = *pDispParams\rgvarg
            WindowSetWidth(*params\lVal)
            
        Case #DISPID_WINDOWSETHEIGHT
            *params.VARIANT = *pDispParams\rgvarg
            WindowSetHeight(*params\lVal)
            
        Case #DISPID_WINDOWSETRESIZABLE
            *params.VARIANT = *pDispParams\rgvarg
            WindowSetResizable(*params\boolVal)
    EndSelect 
EndProcedure

; 
; ;Declare an instance
; dispatch.IDispatch = @dispatchObject
AddElement(DispatchObject())
DispatchObject()\IDispatch = ?dispatchFunctions

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

OpenWindow(0,0,0,640,480,"Test",#PB_Window_SystemMenu | #PB_Window_ScreenCentered)
CreateGadgetList(WindowID(0))
WebGadget(0,0,0,640,480, "http://www.purebasic.com/")
webBrowser.IWebBrowser2 = GetWindowLong_(GadgetID(0), #GWL_USERDATA)
webBrowser\QueryInterface(?IID_IConnectionPointContainer, @connectionPointContainer.IConnectionPointContainer)
connectionPointContainer\findconnectionpoint(?IID_DWebBrowserEvents2, @connectionPoint.IConnectionPoint)
connectionPoint\Advise(DispatchObject(), @Cookie)

Repeat
Until WaitWindowEvent() = #PB_Event_CloseWindow

connectionPoint\UnAdvise(Cookie)
connectionPoint\release()
connectionPointContainer\release()
End

DataSection
dispatchFunctions:
Data.l @QueryInterface(),@AddRef(),@Release(),@GetTypeInfoCount()
Data.l @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
Top
Nico
Enthusiast
Enthusiast
Posts: 274
Joined: Sun Jan 11, 2004 11:34 am
Location: France

Post by Nico »

Use of the event NewWindow2; in the example, I destroy the current Webgadget and I recreate a new which takes its place. (I would have been able to the created in a new tab).

With the event NewWindow2, we are obliged to create a new Webgadget or to use another WebGadget so that the URL is otherwise redirected that does not work.

Code: Select all

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

;//
;// 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.l
    AddRef.l
    Release.l
    GetTypeInfoCount.l
    GetTypeInfo.l
    GetIDsOfNames.l
    Invoke.l
EndStructure

Structure DispatchObject
    *IDispatch.IDispatch
    ObjectCount.l
    GadgetID.l
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 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.l)
    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.l)
    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.l)
    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_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


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

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, "")

 
CreateGadgetList(WindowID(0))
PanelGadget(0, 10, 50, 620, 420)
AddGadgetItem (0, -1, "")
WebGadget(1,10,10,600,380, "http://www.purebasic.fr/german/")
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 = GetWindowLong_(GadgetID(1), #GWL_USERDATA)
webBrowser\QueryInterface(?IID_IConnectionPointContainer, @connectionPointContainer.IConnectionPointContainer)
connectionPointContainer\findconnectionpoint(?IID_DWebBrowserEvents2, @connectionPoint.IConnectionPoint)
connectionPoint\Advise(DispatchObject(), @Cookie)
connectionPoint\release()
connectionPointContainer\release()

Repeat
Until WaitWindowEvent() = #PB_Event_CloseWindow

End

DataSection
dispatchFunctions:
Data.l @QueryInterface(),@AddRef(),@Release(),@GetTypeInfoCount()
Data.l @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
Top
Nico
Enthusiast
Enthusiast
Posts: 274
Joined: Sun Jan 11, 2004 11:34 am
Location: France

Post by Nico »

#DISPID_NEWWINDOW3, work with XP sp2, i think:

Code: Select all

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

Code: Select all

        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)
Last edited by Nico on Thu May 22, 2008 10:19 pm, edited 1 time in total.
Top
ricardo
Addict
Addict
Posts: 2438
Joined: Fri Apr 25, 2003 7:06 pm
Location: Argentina

Post by ricardo »

Nico

I add a second webgadget and it works. But how can i identify for which gadget are every event?

Code: Select all

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

;// 
;// 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.l 
  AddRef.l 
  Release.l 
  GetTypeInfoCount.l 
  GetTypeInfo.l 
  GetIDsOfNames.l 
  Invoke.l 
EndStructure 

Structure DispatchObject 
  *IDispatch.IDispatch 
  ObjectCount.l 
EndStructure 

Global NewList dispatchObject.DispatchObject() 

Procedure BeforeNavigate2(*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(*CX.Long, *CY.Long) 
  Debug "----------------------------------------------" 
  Debug "ClientToHostWindow" 
  Debug *CX\l 
  Debug *CY\l 
EndProcedure 

Procedure CommandStateChange(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(*pDisp.IDispatch, *Url.VARIANT) 
  Debug "----------------------------------------------" 
  Debug "DocumentComplete" 
  Debug PeekL(*Url\bstrVal-4) 
  Debug PeekS(*Url\bstrVal,-1,#PB_Unicode) 
EndProcedure 

Procedure DownloadComplete() 
  Debug "----------------------------------------------" 
  Debug "DownloadComplete" 
EndProcedure 

Procedure DownloadBegin() 
  Debug "----------------------------------------------" 
  Debug "DownloadBegin" 
EndProcedure 

Procedure FileDownload(*bActiveDocument.Long, *bCancel.Long) 
  Debug "----------------------------------------------" 
  Debug "FileDownload" 
  Debug *bActiveDocument\l 
  Debug *bCancel\l 
EndProcedure 

Procedure NavigateComplete2(*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(*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(*ppDisp.Long, *Cancel.Long) 
  Debug "----------------------------------------------" 
  Debug "NewWindow2" 
  Debug *Cancel\l 
EndProcedure 

Procedure OnFullScreen(FullScreen.l) 
  Debug "----------------------------------------------" 
  Debug "OnFullScreen" 
  Debug FullScreen 
EndProcedure 

Procedure OnMenuBar(MenuBar.l) 
  Debug "----------------------------------------------" 
  Debug "OnMenuBar" 
  Debug "MenuBar" 
EndProcedure 

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

Procedure OnStatusBar(StatusBar.l) 
  Debug "----------------------------------------------" 
  Debug "OnStatusBar" 
  Debug "StatusBar" 
EndProcedure 

Procedure OnTheaterMode(TheaterMode.l) 
  Debug "----------------------------------------------" 
  Debug "OnTheaterMode" 
EndProcedure 

Procedure OnToolBar(ToolBar.l) 
  Debug "----------------------------------------------" 
  Debug "OnToolBar" 
  Debug "ToolBar" 
EndProcedure 

Procedure OnVisible(vVisible.l) 
  Debug "----------------------------------------------" 
  Debug "OnVisible" 
  Debug "vVisible" 
EndProcedure 

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

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

Procedure PrivacyImpactedStateChange(bPrivacyImpacted.l) 
  Debug "----------------------------------------------" 
  Debug "bPrivacyImpacted" 
  Debug bPrivacyImpacted 
EndProcedure 

Procedure ProgressChange(nProgress.l, nProgressMax.l) 
  Debug "----------------------------------------------" 
  Debug "ProgressChange" 
  Debug nProgress 
  Debug nProgressMax 
EndProcedure 

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

Procedure SetSecureLockIcon(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(*sText.l) 
  Debug "----------------------------------------------" 
  Debug "StatusTextChange" 
  Debug PeekL(*sText-4) 
  Debug PeekS(*sText,-1,#PB_Unicode) 
EndProcedure 

Procedure TitleChange(*sText.l) 
  Debug "----------------------------------------------" 
  Debug "TitleChange" 
  Debug PeekL(*sText-4) 
  Debug PeekS(*sText,-1,#PB_Unicode) 
EndProcedure 
                
Procedure WindowClosing(bIsChildWindow.l, *Cancel.Long) 
  Debug "----------------------------------------------" 
  Debug "WindowClosing" 
  Debug bIsChildWindow 
EndProcedure 

Procedure WindowSetLeft(nLeft.l) 
  Debug "----------------------------------------------" 
  Debug "WindoSetLeft" 
EndProcedure 

Procedure WindowSetTop(nTop.l) 
  Debug "----------------------------------------------" 
  Debug "WindoSetTop" 
EndProcedure 

Procedure WindowSetWidth(nWidth.l) 
  Debug "----------------------------------------------" 
  Debug "WindoSetTop" 
EndProcedure 

Procedure WindowSetHeight(nHeight.l) 
  Debug "----------------------------------------------" 
  Debug "WindoSetHeight" 
EndProcedure 

Procedure WindowSetResizable(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(*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(*params1\plVal, *params2\plVal) 
      
    Case #DISPID_COMMANDSTATECHANGE 
      *params1.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*1) 
      *params2.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*0) 
      CommandStateChange(*params1\lVal, *params2\boolVal) 
      
    Case #DISPID_DOCUMENTCOMPLETE 
      *params1.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*1) 
      *params2.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*0) 
      DocumentComplete(*params1\pdispVal, *params2\pvarVal) 
      
    Case #DISPID_DOWNLOADBEGIN 
      DownloadBegin() 
      
    Case #DISPID_DOWNLOADCOMPLETE 
      DownloadComplete() 
      
    Case #DISPID_FILEDOWNLOAD 
      *params1.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*1) 
      *params2.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*0) 
      FileDownload(*params1\pboolVal, *params2\pboolVal) 
      
    Case #DISPID_NAVIGATECOMPLETE2 
      *params1.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*1) 
      *params2.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*0) 
      NavigateComplete2(*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(*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(*params1\ppdispVal, *params2\pboolVal) 
      
    Case #DISPID_ONFULLSCREEN 
      *params.VARIANT = *pDispParams\rgvarg 
      OnFullScreen(*params\boolVal) 
      
    Case #DISPID_ONMENUBAR 
      *params.VARIANT = *pDispParams\rgvarg 
      OnMenuBar(*params\boolVal) 
      
    Case #DISPID_ONQUIT 
      OnQuit() 
      
    Case #DISPID_ONSTATUSBAR 
      *params.VARIANT = *pDispParams\rgvarg 
      OnStatusBar(*params\boolVal) 
      
    Case #DISPID_ONTHEATERMODE 
      *params1.VARIANT = *pDispParams\rgvarg 
      OnTheaterMode(*params1\boolVal) 
      
    Case #DISPID_ONTOOLBAR 
      *params.VARIANT = *pDispParams\rgvarg 
      OnToolBar(*params\boolVal) 
      
    Case #DISPID_ONVISIBLE 
      *params.VARIANT = *pDispParams\rgvarg 
      OnVisible(*params\boolVal) 
      
    Case #DISPID_PRINTTEMPLATEINSTANTIATION 
      *params.VARIANT = *pDispParams\rgvarg 
      PrintTemplateInstantiation(*params\pdispVal) 
      
    Case #DISPID_PRINTTEMPLATETEARDOWN 
      *params.VARIANT = *pDispParams\rgvarg 
      PrintTemplateTeardown(*params\pdispVal) 
      
    Case #DISPID_PRIVACYIMPACTEDSTATECHANGE 
      *params.VARIANT = *pDispParams\rgvarg 
      PrivacyImpactedStateChange(*params\boolVal) 
      
    Case #DISPID_PROGRESSCHANGE 
      *params1.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*1) 
      *params2.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*0) 
      ProgressChange(*params1\lVal, *params2\lVal) 
      
    Case #DISPID_PROPERTYCHANGE 
      *params.VARIANT = *pDispParams\rgvarg 
      PropertyChange(*params\bstrVal) 
      
    Case #DISPID_SETSECURELOCKICON 
      *params.VARIANT = *pDispParams\rgvarg 
      SetSecureLockIcon(*params\lVal) 
      
    Case #DISPID_STATUSTEXTCHANGE 
      *params.VARIANT = *pDispParams\rgvarg 
      StatusTextChange(*params\bstrVal) 
      
    Case #DISPID_TITLECHANGE 
      *params.VARIANT = *pDispParams\rgvarg 
      TitleChange(*params\bstrVal) 
      
    Case #DISPID_WINDOWCLOSING 
      *params1.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*1) 
      *params2.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*0) 
      WindowClosing(*params1\boolVal, *params2\pboolVal) 
      
    Case #DISPID_WINDOWSETLEFT 
      *params.VARIANT = *pDispParams\rgvarg 
      WindowSetLeft(*params\lVal) 
      
    Case #DISPID_WINDOWSETTOP 
      *params.VARIANT = *pDispParams\rgvarg 
      WindowSetTop(*params\lVal) 
      
    Case #DISPID_WINDOWSETWIDTH 
      *params.VARIANT = *pDispParams\rgvarg 
      WindowSetWidth(*params\lVal) 
      
    Case #DISPID_WINDOWSETHEIGHT 
      *params.VARIANT = *pDispParams\rgvarg 
      WindowSetHeight(*params\lVal) 
      
    Case #DISPID_WINDOWSETRESIZABLE 
      *params.VARIANT = *pDispParams\rgvarg 
      WindowSetResizable(*params\boolVal) 
  EndSelect 
EndProcedure 

; 
; ;Declare an instance 
; dispatch.IDispatch = @dispatchObject 
AddElement(dispatchObject()) 
dispatchObject()\IDispatch = ?dispatchFunctions 

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

OpenWindow(0,0,0,640,480,"Test",#PB_Window_SystemMenu | #PB_Window_ScreenCentered) 
CreateGadgetList(WindowID(0)) 
WebGadget(0,0,0,640,240, "http://www.purebasic.com/") 
webBrowser.IWebBrowser2 = GetWindowLong_(GadgetID(0), #GWL_USERDATA) 
webBrowser\QueryInterface(?IID_IConnectionPointContainer, @connectionPointContainer.IConnectionPointContainer) 
connectionPointContainer\findconnectionpoint(?IID_DWebBrowserEvents2, @connectionPoint.IConnectionPoint) 
connectionPoint\Advise(dispatchObject(), @Cookie) 

WebGadget(1,0,240,640,240, "http://www.google.com/") 
webBrowser.IWebBrowser2 = GetWindowLong_(GadgetID(1), #GWL_USERDATA) 
webBrowser\QueryInterface(?IID_IConnectionPointContainer, @connectionPointContainer.IConnectionPointContainer) 
connectionPointContainer\findconnectionpoint(?IID_DWebBrowserEvents2, @connectionPoint.IConnectionPoint) 
connectionPoint\Advise(dispatchObject(), @Cookie) 


Repeat 
Until WaitWindowEvent() = #PB_Event_CloseWindow 

connectionPoint\UnAdvise(Cookie) 
connectionPoint\Release() 
connectionPointContainer\Release() 
End 

DataSection 
  dispatchFunctions: 
  Data.l @QueryInterface(),@AddRef(),@Release(),@GetTypeInfoCount() 
  Data.l @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
Top
Post Reply

Return to “Coding Questions”