Web Events

nico · Message par **nico** » jeu. 12/juil./2007 12:45

Ce code permet d'avoir pleins de renseignements sur les évènements du WebGadget.

Entre autres , comme pour IE, vous avez accès au titre de la page, le délai de progression de la page et les infos de téléchargement de la page, l' URL pointée par la souris lorsque celle -ci se balade sur un objet ou lien, lorque qu'un lien ouvre une autre fenêtre vous en êtes avertis et vous avez les moyens de la stopper.

Code : Tout sélectionner

;- 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.l, *bCancel.LONG)
    Debug "----------------------------------------------"
    Debug "FileDownload"
    Debug bActiveDocument
    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_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

wolfjeremy · Message par **wolfjeremy** » jeu. 12/juil./2007 12:47

Merci à soerenkj et à toi même nico pour avoir completer tout ça

nico · Message par **nico** » jeu. 12/juil./2007 12:48

Le lien qui ma permit de compléter ce code, n'hésiter pas à faire des remarques en cas d'erreur:

http://www.codeguru.com/cpp/i-n/ieprogr ... read=51614

Backup · Message par **Backup** » jeu. 12/juil./2007 13:29

bon boulot, comme d'hab !!

Kwai chang caine

Waaaooouuuhhh!!!

Un code pour IE.
C'est de l'or.

Malheureusement il marche pas a mon boulot (Comme dab):?
Y'a tellement de filtre qu'on se demande comment j'arrive encore a vous parler sur ce forum

J'essaierais chez moi.
Merci de ton travail NICO, encore une brique pour mon futur BOT

nico · Message par **nico** » ven. 13/juil./2007 2:29

Un petit exemple:
L'onglet affiche le titre de la page
La Statusbar affiche les informations relatives à la souris et au téléchargement de la page
Le ProgressBarGadget affiche la durée de téléchargement de la page
Et pour finir on peut voir qu'en cliquant sur Links, puis sur French Forum, Internet explorer ne se lance pas, j'annule l'ouverture et je redirige l'url vers le WebGadget

Evidement ça devient un peu plus compliqué dès lors qu'on souhaite utiliser plusieurs onglets avec des WebGagdets.

Code : Tout sélectionner

;- 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()
Global Url.s

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.l, *bCancel.LONG)
Debug "----------------------------------------------"
Debug "FileDownload"
Debug bActiveDocument
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
*Cancel\l=1
SetGadgetText(1, Url)
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)
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(*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)
Protected Texte.s
; Debug "----------------------------------------------"
; Debug "StatusTextChange"
; Debug PeekL(*sText-4)

Texte.s= PeekS(*sText,-1,#PB_Unicode)
StatusBarText(0, 0, Texte)
Url=Texte
EndProcedure

Procedure TitleChange(*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(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,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.com/")
CloseGadgetList()

ProgressBarGadget(2, 10, 10, 200, 20, 0, 100)

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

Le psychopathe · Message par **Le psychopathe** » lun. 16/juil./2007 14:13

bonjours à tous
Nico j'ai un problème car sur les 2 codes si dessus aucun ne fonctionne chez moi xD

Sur la première source :
ligne 119 : Debug *bActiveDocument\l
invalid memory access

nico · Message par **nico** » lun. 16/juil./2007 15:28

J'ai corrigé c'est un long au lieu d'un pointeur.

N'hésite pas à me dire si tu vois d'autres erreurs.

Le psychopathe · Message par **Le psychopathe** » lun. 16/juil./2007 16:22

nico a écrit :J'ai corrigé c'est un long au lieu d'un pointeur.

N'hésite pas à me dire si tu vois d'autres erreurs.

Alors dans le deuxième code :
ligne 262 : Procedure TitleChange(*sText.l)
tu l'as mis en double, un copier coller loupé en gros ^^

voilà la rectification :

Code : Tout sélectionner

;- 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() 
Global Url.s 

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.l, *bCancel.LONG) 
    Debug "----------------------------------------------" 
    Debug "FileDownload" 
    Debug bActiveDocument 
    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 
    *Cancel\l=1 
    SetGadgetText(1, Url) 
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) 
    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(*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) 
    Protected Texte.s 
    ;     Debug "----------------------------------------------" 
    ;     Debug "StatusTextChange" 
    ;     Debug PeekL(*sText-4) 
    
    Texte.s= PeekS(*sText,-1,#PB_Unicode) 
    StatusBarText(0, 0, Texte) 
    Url=Texte 
EndProcedure 

Procedure TitleChange(*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(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,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.com/") 
CloseGadgetList() 

ProgressBarGadget(2,  10, 10, 200,  20, 0, 100) 

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

nico · Message par **nico** » lun. 16/juil./2007 16:26

Ar-S · Message par **Ar-S** » mar. 17/juil./2007 11:32

Excellent ce code !
Le jour ou j'arrive à pondre un truc comme ça... ba je serai devenu une poule

venom · Message par **venom** » mar. 17/juil./2007 17:00

lol

je confirme

ce sont les lois de la nature

.

@++

nico · Message par **nico** » mer. 20/févr./2008 22:34

Dans le code ci-dessus, j'ai utilisé un artifice pour éviter qu'une nouvelle fenêtre IE ne s'ouvre alors bien sûr ça ne marche pas à tous les coups.

J'ai essayé d'intervenir dans la procédure NewWindow2 comme Microsoft le fait remarquer ici: http://support.microsoft.com/kb/311282
mais ça ne marche pas!?

J'ai donc implémenter l'event NewWindow3:

D'abord supprimer la globale Url, elle ne sert plus à rien

ensuite:

Code : Tout sélectionner

Procedure NewWindow2(*ppDisp.LONG, *Cancel.LONG)
;Laisser vide
EndProcedure

Code : Tout sélectionner

Procedure StatusTextChange(*sText.l)
    Protected Texte.s
    ;     Debug "----------------------------------------------"
    ;     Debug "StatusTextChange"
    ;     Debug PeekL(*sText-4)
   
    Texte.s= PeekS(*sText,-1,#PB_Unicode)
    StatusBarText(0, 0, Texte)
    ;Url=Texte<-- supprimer cette ligne
EndProcedure

Rajouter ceci:

Code : Tout sélectionner

        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)

et la procédure qui va avec:

Code : Tout sélectionner

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(1,Nouvelle_url)
  *Cancel\l=-1
EndProcedure

Microsoft souligne que l'event NewWindow3 n'est pas signalé entre autre lorque l'utilisateur fait un click droit puis ouvrir dans une nouvelle fenêtre,
et bien dans mes essais on l'a toujours.

Bien que ça m'arrange, j'aimerais bien comprendre pourquoi!

nico · Message par **nico** » ven. 25/avr./2008 21:54

J'ai enfin pu mettre en place l'évènement NewWindow2; dans l'exemple, je détuis le Webgadget courant et j'en recrée un nouveau qui prend sa place (j'aurais pu le créé dans un nouvel onglet).

Avec l'évènement NewWindow2, on est obligé de créer un nouveau Webgadget ou de se servir d'un autre WebGadget pour que l'URL soit redirigé sinon ça ne marche pas.

L'évènement NewWindow3 ne fonctionne quer sur XP SP2 je crois!, il est plus simple à mettre en oeuvre comme montré dans le post précédent.

Code : Tout sélectionner

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