This works fine in PB 5.62 x86, but crashes when compiled to x64. (IMA at line 113)
Any ideas why? Or if you know of a simpler way of getting the URL of a popup, I'm also interested
Code: Select all
;;; very old snippet, not sure of the original author.
#DISPID_DOWNLOADCOMPLETE = 104
#DISPID_NEWWINDOW3 = 273
#DISPID_DOCUMENTCOMPLETE = $00000103
#DISPID_FILEDOWNLOAD = $0000010E
#DISPID_PROGRESSCHANGE = $0000006C
#DISPID_BEFORENAVIGATE2 = $000000FA
#DISPID_NEWWINDOW2 = 251
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)
; Debug "fired " + Str(Random(1000))
If dispIdMember = #DISPID_DOWNLOADCOMPLETE
Debug "YES!"
ElseIf dispIdMember = #DISPID_NEWWINDOW3
Debug "NewWindow3"
Debug "numargs: "+Str(*pDispParams\cArgs)
*params.VARIANT = *pDispParams\rgvarg
*params2.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*5)
*params3.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*4)
*params4.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*3)
*params5.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*2)
*params6.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*1)
*params7.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*0)
hResult.l = #S_OK
Dim argument.s(1)
Define.VARIANT TmpArg
For Index.l = 0 To 1
VariantInit_(@TmpArg)
If VariantChangeType_(@TmpArg, *pDispParams\rgvarg + ((1 - Index) * SizeOf(VARIANT)), 0, #VT_BSTR) <> #S_OK
hResult = #DISP_E_TYPEMISMATCH
Break
EndIf
argument(Index) = PeekS(TmpArg\bstrVal, -1, #PB_Unicode)
; Debug Str(Index) + " : " + argument(Index) ;<<<<<<<< Okay here it is, the url of the popup :)
VariantClear_(@TmpArg)
Next Index
Debug argument(Index-1)
ElseIf dispIdMember = #DISPID_DOCUMENTCOMPLETE
Debug "Document Complete"
EndIf
EndProcedure
dispatchFunctions.DispatchFunctions\QueryInterface = @QueryInterface()
dispatchFunctions.DispatchFunctions\AddRef = @AddRef()
dispatchFunctions.DispatchFunctions\Release = @Release()
dispatchFunctions.DispatchFunctions\GetTypeInfoCount = @GetTypeInfoCount()
dispatchFunctions.DispatchFunctions\GetTypeInfo = @GetTypeInfo()
dispatchFunctions.DispatchFunctions\GetIDsOfNames = @GetIDsOfNames()
dispatchFunctions.DispatchFunctions\Invoke = @Invoke()
dispatchObject.DispatchObject\dispatchFunctions = dispatchFunctions
;Declare an instance
Dispatch.IDispatch = @dispatchObject
;---------------------------------------------------------------------------------------------
OpenWindow(0,0,0,640,480,"Test",#PB_Window_SystemMenu | #PB_Window_ScreenCentered)
CreateGadgetList(WindowID(0))
WebGadget(0,0,0,640,480, "https://www.iana.org/")
; SetGadgetAttribute(0, #PB_Web_BlockPopups, 1)
WebBrowser.IWebBrowser2 = GetWindowLong_(GadgetID(0), #GWL_USERDATA)
WebBrowser\QueryInterface(?IID_IConnectionPointContainer, @connectionPointContainer.IConnectionPointContainer)
connectionPointContainer\FindConnectionPoint(?IID_DWebBrowserEvents2, @connectionPoint.IConnectionPoint)
connectionPoint\Advise(Dispatch, @Cookie)
Repeat
Until WaitWindowEvent() = #PB_Event_CloseWindow
WebBrowser\Release()
End
DataSection
IID_IConnectionPointContainer:
Data.l $B196B284
Data.w $BAB4, $101A
Data.b $B6, $9C, $00, $AA, $00, $34, $1D, $07
IID_IDispatch:
Data.l $00020400
Data.w $0000, $0000
Data.b $C0, $00, $00, $00, $00, $00, $00, $46
IID_IUnknown:
Data.l $00000000
Data.w $0000, $0000
Data.b $C0, $00, $00, $00, $00, $00, $00, $46
IID_DWebBrowserEvents2:
Data.l $34A715A0
Data.w $6587, $11D0
Data.b $92, $4A, $00, $20, $AF, $C7, $AC, $4D
EndDataSection