Getting URL of Popup (Webgadget) on Win x64

firace · Post by **firace** » Tue Dec 25, 2018 9:05 pm

For the Webgadget/API gurus...

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

Mijikai · Post by **Mijikai** » Tue Dec 25, 2018 10:49 pm

Just looked at it but isn't that supposed to be an interface?

Code: Select all

Structure DispatchFunctions; also -> DispatchObject!
  QueryInterface.l 
  AddRef.l 
  Release.l 
  GetTypeInfoCount.l 
  GetTypeInfo.l 
  GetIDsOfNames.l 
  Invoke.l 
EndStructure

->

Code: Select all

Interface DispatchFunctions 
  QueryInterface.i(*this,*iid,*obj) 
  ;...
EndInterface 

;*XYZ.DispatchFunctions
;*XYZ = ...

Justin · Post by **Justin** » Tue Dec 25, 2018 11:05 pm

this works, just used the integer type at the right places

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.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) 
;     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.purebasic.com/") 
; 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

firace · Post by **firace** » Wed Dec 26, 2018 12:32 am

It works! Thanks a lot, much appreciated.

PureBasic Forums - English

Getting URL of Popup (Webgadget) on Win x64

Getting URL of Popup (Webgadget) on Win x64

Re: Getting URL of Popup (Webgadget) on Win x64

Re: Getting URL of Popup (Webgadget) on Win x64

Re: Getting URL of Popup (Webgadget) on Win x64