WebGadget (Windows) and VARIANT parameter
Posted: Thu Jan 03, 2019 11:51 pm
As a continuation of this other question, I'm now trying to retrieve the URL of a NavigateError event (lines 82-95), but am getting totally lost in the VARIANT stuff. Any ideas from API gurus welcome!
Note: Of course I could simply use "Debug GetGadgetText(0)" in the below example, but that wouldn't help if the NavigateError refers to a resource (image, script, etc) loaded by the page.
Note: Of course I could simply use "Debug GetGadgetText(0)" in the below example, but that wouldn't help if the NavigateError refers to a resource (image, script, etc) loaded by the page.
Code: Select all
;;; very old snippet, not sure of the original author.
#DISPID_DOWNLOADCOMPLETE = 104
#DISPID_NEWWINDOW3 = 273
#DISPID_DOCUMENTCOMPLETE = $00000103
#DISPID_FILEDOWNLOAD = $0000010E
#DISPID_PROGRESSCHANGE = $0000006C
#DISPID_BEFORENAVIGATE2 = $000000FA
#DISPID_NEWWINDOW2 = 251
#DISPID_NAVIGATEERROR= 271
Structure DispatchFunctions
QueryInterface.i
AddRef.i
Release.i
GetTypeInfoCount.i
GetTypeInfo.i
GetIDsOfNames.i
Invoke.i
EndStructure
Structure DispatchObject
*dispatchFunctions.DispatchFunctions
ObjectCount.l
EndStructure
Procedure.l AddRef(*THIS.DispatchObject)
*THIS\ObjectCount + 1
ProcedureReturn *THIS\ObjectCount
EndProcedure
Procedure.l QueryInterface(*THIS.DispatchObject, *IID.GUID, *Object.INTEGER)
If CompareMemory(*IID, ?IID_IUnknown, SizeOf(GUID)) Or CompareMemory(*IID, ?IID_IDispatch, SizeOf(GUID))
*Object\i = *THIS
AddRef(*THIS.DispatchObject)
ProcedureReturn #S_OK
Else : *Object\i = 0 : ProcedureReturn #E_NOINTERFACE : EndIf
EndProcedure
Procedure.l Release(*THIS.DispatchObject)
*THIS\ObjectCount - 1
ProcedureReturn *THIS\ObjectCount
EndProcedure
Procedure GetTypeInfoCount(*THIS.DispatchObject, pctinfo) : EndProcedure
Procedure GetTypeInfo(*THIS.DispatchObject, itinfo, lcid, pptinfo ) : EndProcedure
Procedure GetIDsOfNames(*THIS.DispatchObject, riid, rgszNames, cNames, lcid, rgdispid) : EndProcedure
Procedure Invoke(*THIS.DispatchObject, dispIdMember, riid, lcid, wFlags, *pDispParams.DISPPARAMS, pVarResult, pExcepInfo, puArgErr)
; Debug "fired " + Str(Random(1000))
If dispIdMember = #DISPID_DOWNLOADCOMPLETE
Debug "YES!"
ElseIf dispIdMember = #DISPID_NEWWINDOW3
Debug "NewWindow3"
Debug "numargs: "+Str(*pDispParams\cArgs)
*params.VARIANT = *pDispParams\rgvarg
*params2.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*5)
*params3.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*4)
*params4.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*3)
*params5.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*2)
*params6.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*1)
*params7.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*0)
hResult.l = #S_OK
Dim argument.s(1)
Define.VARIANT TmpArg
For Index.l = 0 To 1
VariantInit_(@TmpArg)
If VariantChangeType_(@TmpArg, *pDispParams\rgvarg + ((1 - Index) * SizeOf(VARIANT)), 0, #VT_BSTR) <> #S_OK
hResult = #DISP_E_TYPEMISMATCH
Break
EndIf
argument(Index) = PeekS(TmpArg\bstrVal, -1, #PB_Unicode)
VariantClear_(@TmpArg)
Next Index
Debug argument(Index-1)
ElseIf dispIdMember = #DISPID_NAVIGATEERROR
Debug "NavigateError"
*params1.VARIANT = *pDispParams\rgvarg
*params2.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*5)
*params3.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*4)
*params4.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*3)
*params5.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*2)
*params6.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*1)
; If *params2\vt = 8 ;#VT_BSTR
; ; Debug PeekL(*Url\bstrval-4)
; Debug *params4\bstrval
; EndIf
Debug PeekS(*params3\bstrval,-1,#PB_Unicode) ;;; trying to get the URL
;;; not quite there yet
ElseIf dispIdMember = #DISPID_DOCUMENTCOMPLETE
Debug "Document Complete"
EndIf
EndProcedure
dispatchFunctions.DispatchFunctions\QueryInterface = @QueryInterface()
dispatchFunctions.DispatchFunctions\AddRef = @AddRef()
dispatchFunctions.DispatchFunctions\Release = @Release()
dispatchFunctions.DispatchFunctions\GetTypeInfoCount = @GetTypeInfoCount()
dispatchFunctions.DispatchFunctions\GetTypeInfo = @GetTypeInfo()
dispatchFunctions.DispatchFunctions\GetIDsOfNames = @GetIDsOfNames()
dispatchFunctions.DispatchFunctions\Invoke = @Invoke()
dispatchObject.DispatchObject\dispatchFunctions = dispatchFunctions
;Declare an instance
Dispatch.IDispatch = @dispatchObject
;---------------------------------------------------------------------------------------------
OpenWindow(0,0,0,640,480,"Test",#PB_Window_SystemMenu | #PB_Window_ScreenCentered)
CreateGadgetList(WindowID(0))
WebGadget(0,0,0,640,480, "https://www.google.com/nonexistentpage")
; SetGadgetAttribute(0, #PB_Web_BlockPopups, 1)
WebBrowser.IWebBrowser2 = GetWindowLong_(GadgetID(0), #GWL_USERDATA)
WebBrowser\QueryInterface(?IID_IConnectionPointContainer, @connectionPointContainer.IConnectionPointContainer)
connectionPointContainer\FindConnectionPoint(?IID_DWebBrowserEvents2, @connectionPoint.IConnectionPoint)
connectionPoint\Advise(Dispatch, @Cookie)
Repeat
Until WaitWindowEvent() = #PB_Event_CloseWindow
WebBrowser\Release()
End
DataSection
IID_IConnectionPointContainer:
Data.l $B196B284
Data.w $BAB4, $101A
Data.b $B6, $9C, $00, $AA, $00, $34, $1D, $07
IID_IDispatch:
Data.l $00020400
Data.w $0000, $0000
Data.b $C0, $00, $00, $00, $00, $00, $00, $46
IID_IUnknown:
Data.l $00000000
Data.w $0000, $0000
Data.b $C0, $00, $00, $00, $00, $00, $00, $46
IID_DWebBrowserEvents2:
Data.l $34A715A0
Data.w $6587, $11D0
Data.b $92, $4A, $00, $20, $AF, $C7, $AC, $4D
EndDataSection