PureBasic Forums - English

Posted: **Sun Mar 17, 2024 11:00 am**

Method 1 is a bit imperfect. On some sites, some elements are sometimes not captured.
On the other hand, method 2 is a bit more tricky, but it captures the page properly.

Note: The page must be completely loaded to be captured properly.

Tested with PB 6.10 b8 x64 on Windows 10 Home 22H2 build 19045.4170 x64.

Edit:
Bug fixed.
Putting both methods in one function so you can choose between them.

Edit2:
Added some code in "New code" below. (the commented part)

Edit3:
The SetGadgetAttribute bug was fixed in 6.10 beta 9, so I switched to using Get/SetGadgetAttribute instead of JavaScript code.

New code:

Code: Select all

EnableExplicit

UsePNGImageDecoder()

; struct tagSTATSTG {
;   LPOLESTR       pwcsName;
;   DWORD          type;
;   ULARGE_INTEGER cbSize;
;   FILETIME       mtime;
;   FILETIME       ctime;
;   FILETIME       atime;
;   DWORD          grfMode;
;   DWORD          grfLocksSupported;
;   CLSID          clsid;
;   DWORD          grfStateBits;
;   DWORD          reserved;
; } STATSTG;
Structure STATSTG Align #PB_Structure_AlignC
  *pwcsName
  type.l
  cbSize.q
  mtime.FILETIME
  ctime.FILETIME
  atime.FILETIME
  grfMode.l
  grfLocksSupported.l
  clsid.CLSID
  grfStateBits.l
  reserved.l
EndStructure

; https://learn.microsoft.com/en-us/windows/win32/api/shlwapi/nf-shlwapi-shcreatememstream

; IStream * SHCreateMemStream(
;   [in, optional] const BYTE *pInit,
;   [in]           UINT       cbInit
; );
Prototype SHCreateMemStream(*pInit, cbInit)
Global SHCreateMemStream__.SHCreateMemStream

Enumeration 1
  #CallDevToolsProtocol_ReturnType_CaptureScreenshot
EndEnumeration

DataSection
  IID_IUnknown:
  Data.l $00000000
  Data.w $0000, $0000
  Data.b $C0, $00, $00, $00, $00, $00, $00, $46
EndDataSection

Structure STRUC_IUnknownBase
  *pVtbl
  *pQueryInterface
  *pAddRef
  *pRelease
  *pInvoke
  
  iRefCount.i
  hEvent.i
EndStructure

Structure STRUC_ICoreWebView2ExecuteScriptCompletedHandler Extends STRUC_IUnknownBase
  *pValue1.Integer
  *pValue2.Integer
EndStructure

Structure STRUC_ICoreWebView2CallDevToolsProtocolMethodCompletedHandler Extends STRUC_IUnknownBase
  *pValue.Integer
  ReturnType.i
EndStructure

Structure STRUC_ICoreWebView2CapturePreviewCompletedHandler Extends STRUC_IUnknownBase
  *pValue.Integer
  *pMemStream.IStream
EndStructure

Procedure.l CoreWebView2CompletedHandler_QueryInterface(*this.STRUC_IUnknownBase, *riid.IID, *ppvObject.Integer)
  If *ppvObject And *riid
    If CompareMemory(*riid, ?IID_IUnknown, SizeOf(IID))
      *this\iRefCount + 1
      *ppvObject\i = *this
    Else
      *ppvObject\i = 0
      ProcedureReturn #E_NOINTERFACE
    EndIf
  Else
    ProcedureReturn #E_POINTER
  EndIf
  ProcedureReturn #S_OK
EndProcedure

Procedure.l CoreWebView2CompletedHandler_AddRef(*this.STRUC_IUnknownBase)
  *this\iRefCount + 1
  ProcedureReturn *this\iRefCount
EndProcedure

Procedure.l CoreWebView2CompletedHandler_Release(*this.STRUC_IUnknownBase)
  *this\iRefCount - 1
  ProcedureReturn *this\iRefCount
EndProcedure

Procedure.l CoreWebView2ExecuteScriptCompletedHandler_Invoke(*this.STRUC_ICoreWebView2ExecuteScriptCompletedHandler, errorCode.l, *returnObjectAsJson)
  Protected sResult.s, iCount
  
  If errorCode = #S_OK
    If *returnObjectAsJson
      ;Debug #PB_Compiler_Procedure + "     " + PeekS(*returnObjectAsJson)
      sResult = Trim(PeekS(*returnObjectAsJson), ~"\"")
      If sResult
        iCount = CountString(sResult, ",")
        If iCount > 0
          If *this\pValue1
            *this\pValue1\i = Val(StringField(sResult, 1, ","))
          EndIf
          If *this\pValue2
            *this\pValue2\i = Val(StringField(sResult, 2, ","))
          EndIf
        EndIf
      EndIf
    EndIf
  EndIf
  
  If *this\hEvent
    SetEvent_(*this\hEvent)
  EndIf
  ProcedureReturn #S_OK
EndProcedure

Procedure.l CoreWebView2CapturePreviewCompletedHandler_Invoke(*this.STRUC_ICoreWebView2CapturePreviewCompletedHandler, errorCode.l)
  Protected *buffer, stat.STATSTG, iReadBytes, iImage
  
  If errorCode = #S_OK
    If *this\pMemStream
      If errorCode = #S_OK
        If *this\pMemStream\Stat(@stat, #STATFLAG_NONAME) = #S_OK
          If stat\cbSize > 0
            *buffer = AllocateMemory(stat\cbSize)
            If *buffer
              If *this\pMemStream\Seek(0, #STREAM_SEEK_SET, 0) = #S_OK
                If *this\pMemStream\Read(*buffer, stat\cbSize, @iReadBytes) = #S_OK
                  iImage = CatchImage(#PB_Any, *buffer, iReadBytes)
                  If iImage
                    *this\pValue\i = iImage
                  EndIf
                EndIf
              EndIf
              FreeMemory(*buffer)
            EndIf
          EndIf
        EndIf
      EndIf
    EndIf
  EndIf
  
  If *this\hEvent
    SetEvent_(*this\hEvent)
  EndIf
  
  ProcedureReturn #S_OK
EndProcedure

Procedure.l CoreWebView2CallDevToolsProtocolMethodCompletedHandler_Invoke(*this.STRUC_ICoreWebView2CallDevToolsProtocolMethodCompletedHandler, errorCode.l, *returnObjectAsJson)
  Protected sJSON.s, iJSON, iJSONValue, sImgData.s, iImgDataStrLen, *buffer, iDecodedBytes, iImage
  
  If errorCode = #S_OK
    If *returnObjectAsJson
      sJson = PeekS(*returnObjectAsJson)
      If sJSON
        iJSON = ParseJSON(#PB_Any, sJSON)
        If iJSON
          iJSONValue = JSONValue(iJSON)
          Select *this\ReturnType
            Case #CallDevToolsProtocol_ReturnType_CaptureScreenshot
              sImgData = GetJSONString(GetJSONMember(iJSONValue, "data"))
              If sImgData
                iImgDataStrLen = Len(sImgData)
                If iImgDataStrLen > 0
                  *buffer = AllocateMemory(iImgDataStrLen * 2)
                  If *buffer
                    iDecodedBytes = Base64Decoder(sImgData, *buffer, MemorySize(*buffer))
                    If iDecodedBytes > 0
                      iImage = CatchImage(#PB_Any, *buffer, iDecodedBytes)
                      If iImage
                        *this\pValue\i = iImage
                      EndIf
                    EndIf
                    FreeMemory(*buffer)
                  EndIf
                EndIf
              EndIf
              
            Default
              ;Debug sJSON
              
          EndSelect
          
          FreeJSON(iJSON)
        EndIf
      EndIf
      
    EndIf
  EndIf
  
  If *this\hEvent
    SetEvent_(*this\hEvent)
  EndIf
  
  ProcedureReturn #S_OK
EndProcedure


; CaptureMethod:
;     0 = ICoreWebView2\CapturePreview()
;     1 = ICoreWebView2\CallDevToolsProtocolMethod()
; 
; Return value: 0(Failed), Image number.
Procedure CaptureEdgeWeb(WebGadget, CaptureMethod = 0)
  Protected Result
  Protected Controller.ICoreWebView2Controller, Core.ICoreWebView2
  Protected *ExecuteScriptCompletedHandler.STRUC_ICoreWebView2ExecuteScriptCompletedHandler
  Protected *CallDevToolsProtocolMethodCompletedHandler.STRUC_ICoreWebView2CallDevToolsProtocolMethodCompletedHandler
  Protected *CapturePreviewCompletedHandler.STRUC_ICoreWebView2CapturePreviewCompletedHandler
  Protected hEvent, w, h, iScrollX, iScrollY, sParam.s
  
  If GadgetType(WebGadget) <> #PB_GadgetType_Web : ProcedureReturn 0 : EndIf
  If CaptureMethod = 1 And SHCreateMemStream__ = 0 : ProcedureReturn 0 : EndIf
  
  Controller = GetGadgetAttribute(WebGadget, #PB_WebView_ICoreController)
  If Controller = 0 : Goto Proc_Exit : EndIf
  
  If Controller\get_CoreWebView2(@Core) <> #S_OK Or Core = 0 : Goto Proc_Exit : EndIf
  
  hEvent = CreateEvent_(0, 0, 0, 0)
  If hEvent = 0 : Goto Proc_Exit : EndIf
  
  *ExecuteScriptCompletedHandler = AllocateMemory(SizeOf(STRUC_ICoreWebView2ExecuteScriptCompletedHandler))
  If *ExecuteScriptCompletedHandler = 0 : Goto Proc_Exit : EndIf
  
  With *ExecuteScriptCompletedHandler
    \pVtbl = *ExecuteScriptCompletedHandler + OffsetOf(STRUC_IUnknownBase\pQueryInterface)
    \pQueryInterface = @CoreWebView2CompletedHandler_QueryInterface()
    \pAddRef = @CoreWebView2CompletedHandler_AddRef()
    \pRelease = @CoreWebView2CompletedHandler_Release()
    \pInvoke = @CoreWebView2ExecuteScriptCompletedHandler_Invoke()
    
    \hEvent = hEvent
  EndWith
  
  *ExecuteScriptCompletedHandler\pValue1 = @w
  *ExecuteScriptCompletedHandler\pValue2 = @h
  ;If Core\ExecuteScript(~"document.body.scrollWidth + \",\" + document.body.scrollHeight", *ExecuteScriptCompletedHandler) = #S_OK
  If Core\ExecuteScript(~"document.documentElement.scrollWidth + \",\" + document.documentElement.scrollHeight", *ExecuteScriptCompletedHandler) = #S_OK
    While WaitForSingleObject_(hEvent, 0) <> #WAIT_OBJECT_0
      While WindowEvent() : Wend
    Wend
  EndIf
  
  iScrollX = GetGadgetAttribute(WebGadget, #PB_Web_ScrollX)
  iScrollY = GetGadgetAttribute(WebGadget, #PB_Web_ScrollY)
  
  ;*ExecuteScriptCompletedHandler\pValue1 = @iScrollX
  ;*ExecuteScriptCompletedHandler\pValue2 = @iScrollY
  ;;If Core\ExecuteScript(~"document.documentElement.scrollLeft + \",\" + document.documentElement.scrollTop", *ExecuteScriptCompletedHandler) = #S_OK
  ;If Core\ExecuteScript(~"window.scrollX + \",\" + window.scrollY", *ExecuteScriptCompletedHandler) = #S_OK
  ;  While WaitForSingleObject_(hEvent, 0) <> #WAIT_OBJECT_0
  ;    While WindowEvent() : Wend
  ;  Wend
  ;EndIf
  
  If w <= 0 Or h <= 0 : Goto Proc_Exit : EndIf
  
  *CallDevToolsProtocolMethodCompletedHandler = AllocateMemory(SizeOf(STRUC_ICoreWebView2CallDevToolsProtocolMethodCompletedHandler))
  If *CallDevToolsProtocolMethodCompletedHandler = 0 : Goto Proc_Exit : EndIf
  
  With *CallDevToolsProtocolMethodCompletedHandler
    \pVtbl = *CallDevToolsProtocolMethodCompletedHandler + OffsetOf(STRUC_IUnknownBase\pQueryInterface)
    \pQueryInterface = @CoreWebView2CompletedHandler_QueryInterface()
    \pAddRef = @CoreWebView2CompletedHandler_AddRef()
    \pRelease = @CoreWebView2CompletedHandler_Release()
    \pInvoke = @CoreWebView2CallDevToolsProtocolMethodCompletedHandler_Invoke()
    
    \hEvent = hEvent
    \pValue = @Result
  EndWith
  
  ; https://chromedevtools.github.io/devtools-protocol/tot/Emulation/#method-setScrollbarsHidden
  *CallDevToolsProtocolMethodCompletedHandler\ReturnType = 0
  If Core\CallDevToolsProtocolMethod("Emulation.setScrollbarsHidden", ~"{\"hidden\" : true}", *CallDevToolsProtocolMethodCompletedHandler) = #S_OK
    While WaitForSingleObject_(hEvent, 0) <> #WAIT_OBJECT_0
      While WindowEvent() : Wend
    Wend
  EndIf
  
  
  ; https://chromedevtools.github.io/devtools-protocol/tot/Emulation/#method-setVisibleSize
  *CallDevToolsProtocolMethodCompletedHandler\ReturnType = 0
  sParam = ~"{ \"width\" : " + w + ~", \"height\" : " + h + "}"
  If Core\CallDevToolsProtocolMethod("Emulation.setVisibleSize", sParam, *CallDevToolsProtocolMethodCompletedHandler) = #S_OK
    While WaitForSingleObject_(hEvent, 0) <> #WAIT_OBJECT_0
      While WindowEvent() : Wend
    Wend
  EndIf
  
  ; The above method is actually deprecated, so use this if it doesn't work in the future.
  ; https://chromedevtools.github.io/devtools-protocol/tot/Emulation/#method-setDeviceMetricsOverride
;   sParam = ~"{ \"width\" : " + w + ~", \"height\" : " + h + ~", \"deviceScaleFactor\" : 0, \"mobile\" : false, \"dontSetVisibleSize\" : false }"
;   *CallDevToolsProtocolMethodCompletedHandler\ReturnType = 0
;   If Core\CallDevToolsProtocolMethod("Emulation.setDeviceMetricsOverride", sParam, *CallDevToolsProtocolMethodCompletedHandler) = #S_OK
;     While WaitForSingleObject_(hEvent, 0) <> #WAIT_OBJECT_0
;       While WindowEvent() : Wend
;     Wend
;   EndIf
  
  
  If CaptureMethod = 0
    *CapturePreviewCompletedHandler = AllocateMemory(SizeOf(STRUC_ICoreWebView2CapturePreviewCompletedHandler))
    If *CapturePreviewCompletedHandler = 0 : Goto Proc_Exit : EndIf
    
    With *CapturePreviewCompletedHandler
      \pVtbl = *CapturePreviewCompletedHandler + OffsetOf(STRUC_IUnknownBase\pQueryInterface)
      \pQueryInterface = @CoreWebView2CompletedHandler_QueryInterface()
      \pAddRef = @CoreWebView2CompletedHandler_AddRef()
      \pRelease = @CoreWebView2CompletedHandler_Release()
      \pInvoke = @CoreWebView2CapturePreviewCompletedHandler_Invoke()
      
      \pValue = @Result
      \hEvent = hEvent
      \pMemStream = SHCreateMemStream__(0, 0)
      
      If \pMemStream = 0 : Goto Proc_Exit : EndIf
      
      If Core\CapturePreview(#COREWEBVIEW2_CAPTURE_PREVIEW_IMAGE_FORMAT_PNG, \pMemStream, *CapturePreviewCompletedHandler) = #S_OK
        While WaitForSingleObject_(hEvent, 0) <> #WAIT_OBJECT_0
          While WindowEvent() : Wend
        Wend
      EndIf
      
      If \pMemStream : \pMemStream\Release() : EndIf
    EndWith
  EndIf
  
  If CaptureMethod = 1
    *CallDevToolsProtocolMethodCompletedHandler\ReturnType = #CallDevToolsProtocol_ReturnType_CaptureScreenshot
    sParam = ~"{ \"format\" : \"png\", \"quality\" : 100, \"clip\" : { \"x\" : 0, \"y\" : 0, \"width\" : " + w + ~", \"height\" : " + h + ~", \"scale\" : 1 }, \"fromSurface\" : true, \"captureBeyondViewport\" : true, \"optimizeForSpeed\" : false }"
    ;sParam = ~"{ \"format\" : \"png\", \"quality\" : 100, \"clip\" : { \"x\" : 0, \"y\" : 0, \"width\" : " + w + ~", \"height\" : " + h + ~", \"scale\" : 1 }, \"fromSurface\" : true, \"captureBeyondViewport\" : false, \"optimizeForSpeed\" : false }"
    If Core\CallDevToolsProtocolMethod("Page.captureScreenshot", sParam, *CallDevToolsProtocolMethodCompletedHandler) = #S_OK
      While WaitForSingleObject_(hEvent, 0) <> #WAIT_OBJECT_0
        While WindowEvent() : Wend
      Wend
    EndIf
  EndIf
  
  *CallDevToolsProtocolMethodCompletedHandler\ReturnType = 0
  If Core\CallDevToolsProtocolMethod("Emulation.setScrollbarsHidden", ~"{\"hidden\" : false}", *CallDevToolsProtocolMethodCompletedHandler) = #S_OK
    While WaitForSingleObject_(hEvent, 0) <> #WAIT_OBJECT_0
      While WindowEvent() : Wend
    Wend
  EndIf
  
  ;*CallDevToolsProtocolMethodCompletedHandler\ReturnType = 0
  sParam = ~"{ \"width\" : " + GadgetWidth(WebGadget) + ~", \"height\" : " + GadgetHeight(WebGadget) + "}"
  If Core\CallDevToolsProtocolMethod("Emulation.setVisibleSize", sParam, *CallDevToolsProtocolMethodCompletedHandler) = #S_OK
    While WaitForSingleObject_(hEvent, 0) <> #WAIT_OBJECT_0
      While WindowEvent() : Wend
    Wend
  EndIf
  
  ; The above method is actually deprecated, so use this if it doesn't work in the future.
;   sParam = ~"{ \"width\" : " + GadgetWidth(WebGadget) + ~", \"height\" : " + GadgetHeight(WebGadget) + ~", \"deviceScaleFactor\" : 0, \"mobile\" : false, \"dontSetVisibleSize\" : false }"
;   *CallDevToolsProtocolMethodCompletedHandler\ReturnType = 0
;   If Core\CallDevToolsProtocolMethod("Emulation.setDeviceMetricsOverride", sParam, *CallDevToolsProtocolMethodCompletedHandler) = #S_OK
;     While WaitForSingleObject_(hEvent, 0) <> #WAIT_OBJECT_0
;       While WindowEvent() : Wend
;     Wend
;   EndIf
  
  If iScrollX <> 0 Or iScrollY <> 0
    SetGadgetAttribute(WebGadget, #PB_Web_ScrollX, iScrollX)
    SetGadgetAttribute(WebGadget, #PB_Web_ScrollY, iScrollY)
    
    ;;*ExecuteScriptCompletedHandler\pValue1 = 0
    ;;*ExecuteScriptCompletedHandler\pValue2 = 0
    ;If Core\ExecuteScript("window.scrollTo(" + iScrollX + "," + iScrollY + ")", *ExecuteScriptCompletedHandler) = #S_OK
    ;  While WaitForSingleObject_(hEvent, 0) <> #WAIT_OBJECT_0
    ;    While WindowEvent() : Wend
    ;  Wend
    ;EndIf
  EndIf
  
  
  Proc_Exit:
  If hEvent : CloseHandle_(hEvent) : EndIf
  If *ExecuteScriptCompletedHandler : FreeMemory(*ExecuteScriptCompletedHandler) : EndIf
  If *CallDevToolsProtocolMethodCompletedHandler : FreeMemory(*CallDevToolsProtocolMethodCompletedHandler) : EndIf
  If *CapturePreviewCompletedHandler : FreeMemory(*CapturePreviewCompletedHandler) : EndIf
  If Core : Core\Release() : EndIf
  
  ProcedureReturn Result
EndProcedure

Define Lib_Shlwapi = OpenLibrary(#PB_Any, "Shlwapi.dll")
If Lib_Shlwapi
  SHCreateMemStream__ = GetFunction(Lib_Shlwapi, "SHCreateMemStream")
  If SHCreateMemStream__ = 0
    Debug "error: Cannot get SHCreateMemStream function."
    
    End
    
  EndIf
EndIf

Define e, img, t

OpenWindow(0, 0, 0, 1000, 600, "", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
ButtonGadget(0, 10, 4, 80, 24, "Capture 1")
ButtonGadget(1, 110, 4, 80, 24, "Capture 2")
StringGadget(2, 210, 4, 500, 24, "https://www.purebasic.com")
ButtonGadget(3, 710, 4, 50, 24, "Go")
WebGadget(4, 0, 30, 1000, 560, "https://www.purebasic.com", #PB_Web_Edge)

Repeat
  e = WaitWindowEvent()
  
  If e = #PB_Event_Gadget
    Select EventGadget()
      Case 0
        t = ElapsedMilliseconds()
        img = CaptureEdgeWeb(4)
        t = ElapsedMilliseconds() - t
        SetWindowTitle(0, Str(t))
        
      Case 1
        t = ElapsedMilliseconds()
        img = CaptureEdgeWeb(4, 1)
        t = ElapsedMilliseconds() - t
        SetWindowTitle(0, Str(t))
        
      Case 3
        SetGadgetText(4, Trim(GetGadgetText(2)))
        
      Default
        Continue
        
    EndSelect
    
    If img
      ;SaveImage(img, "z:\" + Str(Date()) + ".bmp", #PB_ImagePlugin_BMP)
      ShowLibraryViewer("image", img)
      img = 0
    EndIf
    
  EndIf
  
Until e = #PB_Event_CloseWindow

CloseLibrary(Lib_Shlwapi)

Method 1:

Code: Select all

EnableExplicit

UsePNGImageDecoder()

DataSection
  IID_IUnknown:
  Data.l $00000000
  Data.w $0000, $0000
  Data.b $C0, $00, $00, $00, $00, $00, $00, $46
EndDataSection

Structure STRUC_ICoreWebView2CompletedHandler
  *pVtbl
  lRefCount.l
  hEvent.i
  *pValue.Integer
  
  *pQueryInterface
  *pAddRef
  *pRelease
  *pInvoke
EndStructure

Procedure.l CoreWebView2CompletedHandler_QueryInterface(*this.STRUC_ICoreWebView2CompletedHandler, *riid.IID, *ppvObject.Integer)
  If *ppvObject And *riid
    If CompareMemory(*riid, ?IID_IUnknown, SizeOf(IID))
      *this\lRefCount + 1
      *ppvObject\i = *this
      
    Else
      *ppvObject\i = 0
      ProcedureReturn #E_NOINTERFACE
    EndIf
  Else
    ProcedureReturn #E_POINTER
  EndIf
  
  ProcedureReturn #S_OK
EndProcedure

Procedure.l CoreWebView2CompletedHandler_AddRef(*this.STRUC_ICoreWebView2CompletedHandler)
  *this\lRefCount + 1
  ProcedureReturn *this\lRefCount
EndProcedure

Procedure.l CoreWebView2CallDevToolsProtocolMethodCompletedHandler_Release(*this.STRUC_ICoreWebView2CompletedHandler)
  *this\lRefCount - 1
  If *this\lRefCount <= 0
    FreeMemory(*this)
    ProcedureReturn 0
  EndIf
  ProcedureReturn *this\lRefCount
EndProcedure

Procedure.l CoreWebView2CallDevToolsProtocolMethodCompletedHandler_Invoke(*this.STRUC_ICoreWebView2CompletedHandler, errorCode.l, *returnObjectAsJson)
  Protected sJSON.s, iJSON, sImgData.s, iImgDataStrLen, *buffer, iDecodedBytes, iImage
  
  If *returnObjectAsJson
    If errorCode = #S_OK
      sJson = PeekS(*returnObjectAsJson)
      If sJSON
        iJSON = ParseJSON(#PB_Any, sJSON)
        If iJSON
          sImgData = GetJSONString(GetJSONMember(JSONValue(iJSON), "data"))
          If sImgData
            iImgDataStrLen = Len(sImgData)
            If iImgDataStrLen > 0
              *buffer = AllocateMemory(iImgDataStrLen * 2)
              If *buffer
                iDecodedBytes = Base64Decoder(sImgData, *buffer, MemorySize(*buffer))
                If iDecodedBytes > 0
                  iImage = CatchImage(#PB_Any, *buffer, iDecodedBytes)
                  If iImage
                    *this\pValue\i = iImage
                    EndIf
                EndIf
                FreeMemory(*buffer)
              EndIf
            EndIf
          EndIf
          FreeJSON(iJSON)
        EndIf
      EndIf
    EndIf
  EndIf
  
  If *this\hEvent
    SetEvent_(*this\hEvent)
  EndIf
  
  ProcedureReturn #S_OK
EndProcedure


Procedure.l CoreWebView2ExecuteScriptCompletedHandler_Release(*this.STRUC_ICoreWebView2CompletedHandler)
  *this\lRefCount - 1
  ProcedureReturn *this\lRefCount
EndProcedure

Procedure.l CoreWebView2ExecuteScriptCompletedHandler_Invoke(*this.STRUC_ICoreWebView2CompletedHandler, errorCode.l, *returnObjectAsJson)
  If *returnObjectAsJson
    If errorCode = #S_OK
      ;Debug Val(PeekS(*returnObjectAsJson))
      If *this\pValue
        *this\pValue\i = Val(PeekS(*returnObjectAsJson))
      EndIf
    EndIf
  EndIf
  
  If *this\hEvent
    SetEvent_(*this\hEvent)
  EndIf
  ProcedureReturn #S_OK
EndProcedure

; Return value: 0(Failed), Image number.
Procedure CaptureEdgeWeb(WebGadget)
  Protected Result
  Protected Controller.ICoreWebView2Controller, Core.ICoreWebView2
  Protected *CoreWebView2CallDevToolsProtocolMethodCompletedHandler.STRUC_ICoreWebView2CompletedHandler
  Protected *CoreWebView2ExecuteScriptCompletedHandler.STRUC_ICoreWebView2CompletedHandler
  Protected hEvent, iValue, w, h, sParam.s
  
  If GadgetType(WebGadget) <> #PB_GadgetType_Web : ProcedureReturn 0 : EndIf
  
  Controller = GetGadgetAttribute(WebGadget, #PB_WebView_ICoreController)
  If Controller = 0 : Goto Proc_Exit : EndIf
  
  If Controller\get_CoreWebView2(@Core) <> #S_OK Or Core = 0 : Goto Proc_Exit : EndIf
  
  *CoreWebView2ExecuteScriptCompletedHandler = AllocateMemory(SizeOf(STRUC_ICoreWebView2CompletedHandler))
  If *CoreWebView2ExecuteScriptCompletedHandler = 0 : Goto Proc_Exit : EndIf
  
  hEvent = CreateEvent_(0, 0, 0, 0)
  If hEvent = 0 : Goto Proc_Exit : EndIf
  
  With *CoreWebView2ExecuteScriptCompletedHandler
    \pVtbl = *CoreWebView2ExecuteScriptCompletedHandler + OffsetOf(STRUC_ICoreWebView2CompletedHandler\pQueryInterface)
    \pQueryInterface = @CoreWebView2CompletedHandler_QueryInterface()
    \pAddRef = @CoreWebView2CompletedHandler_AddRef()
    \pRelease = @CoreWebView2ExecuteScriptCompletedHandler_Release()
    \pInvoke = @CoreWebView2ExecuteScriptCompletedHandler_Invoke()
    
    \pValue = @iValue
    \hEvent = hEvent
  EndWith
  
  If Core\ExecuteScript("document.body.scrollWidth", *CoreWebView2ExecuteScriptCompletedHandler) = #S_OK
    
    While WaitForSingleObject_(hEvent, 0) <> #WAIT_OBJECT_0
      While WindowEvent() : Wend
    Wend
    
    w = iValue
  EndIf
  
  If Core\ExecuteScript("document.body.scrollHeight", *CoreWebView2ExecuteScriptCompletedHandler) = #S_OK
    
    While WaitForSingleObject_(hEvent, 0) <> #WAIT_OBJECT_0
      While WindowEvent() : Wend
    Wend
    
    h = iValue
  EndIf
  
  FreeMemory(*CoreWebView2ExecuteScriptCompletedHandler)
  *CoreWebView2ExecuteScriptCompletedHandler = 0
  
  If w <= 0 Or h <= 0 : Goto Proc_Exit : EndIf
  
  *CoreWebView2CallDevToolsProtocolMethodCompletedHandler = AllocateMemory(SizeOf(STRUC_ICoreWebView2CompletedHandler))
  If *CoreWebView2CallDevToolsProtocolMethodCompletedHandler = 0 : Goto Proc_Exit : EndIf
  
  With *CoreWebView2CallDevToolsProtocolMethodCompletedHandler
    \pVtbl = *CoreWebView2CallDevToolsProtocolMethodCompletedHandler + OffsetOf(STRUC_ICoreWebView2CompletedHandler\pQueryInterface)
    \pQueryInterface = @CoreWebView2CompletedHandler_QueryInterface()
    \pAddRef = @CoreWebView2CompletedHandler_AddRef()
    \pRelease = @CoreWebView2CallDevToolsProtocolMethodCompletedHandler_Release()
    \pInvoke = @CoreWebView2CallDevToolsProtocolMethodCompletedHandler_Invoke()
    
    \pValue = @Result
    \hEvent = hEvent
  EndWith
  
  ; https://chromedevtools.github.io/devtools-protocol/tot/Page/#method-captureScreenshot
  
  sParam = ~"{ \"format\" : \"png\", \"quality\" : 100, \"clip\" : { \"x\" : 0, \"y\" : 0, \"width\" : " + w + ~", \"height\" : " + h + ~", \"scale\" : 1 }, \"fromSurface\" : true, \"captureBeyondViewport\" : true, \"optimizeForSpeed\" : false }"
  
  ;If Core\CallDevToolsProtocolMethod("Page.captureScreenshot", "{}", *CoreWebView2CallDevToolsProtocolMethodCompletedHandler) = #S_OK
  If Core\CallDevToolsProtocolMethod("Page.captureScreenshot", sParam, *CoreWebView2CallDevToolsProtocolMethodCompletedHandler) = #S_OK
    
    While WaitForSingleObject_(hEvent, 0) <> #WAIT_OBJECT_0
      While WindowEvent() : Wend
    Wend
    
    *CoreWebView2CallDevToolsProtocolMethodCompletedHandler = 0
  EndIf
  
  Core\Release()
  
  Proc_Exit:
  If hEvent : CloseHandle_(hEvent) : EndIf
  If *CoreWebView2ExecuteScriptCompletedHandler : FreeMemory(*CoreWebView2ExecuteScriptCompletedHandler) : EndIf
  If *CoreWebView2CallDevToolsProtocolMethodCompletedHandler : FreeMemory(*CoreWebView2CallDevToolsProtocolMethodCompletedHandler) : EndIf
  
  ProcedureReturn Result
EndProcedure


Define e, img

OpenWindow(0, 0, 0, 1000, 700, "", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
ButtonGadget(0, 20, 4, 80, 24, "Capture")
WebGadget(1, 0, 30, 1000, 660, "https://www.purebasic.com", #PB_Web_Edge)

Repeat
  e = WaitWindowEvent()
  
  If e = #PB_Event_Gadget And EventGadget() = 0
    
    img = CaptureEdgeWeb(1)
    
    If img
      ShowLibraryViewer("image", img)
    EndIf
    
  EndIf
  
Until e = #PB_Event_CloseWindow

Method 2:

Code: Select all

EnableExplicit

UsePNGImageDecoder()

; struct tagSTATSTG {
;   LPOLESTR       pwcsName;
;   DWORD          type;
;   ULARGE_INTEGER cbSize;
;   FILETIME       mtime;
;   FILETIME       ctime;
;   FILETIME       atime;
;   DWORD          grfMode;
;   DWORD          grfLocksSupported;
;   CLSID          clsid;
;   DWORD          grfStateBits;
;   DWORD          reserved;
; } STATSTG;
Structure STATSTG Align #PB_Structure_AlignC
  *pwcsName
  type.l
  cbSize.q
  mtime.FILETIME
  ctime.FILETIME
  atime.FILETIME
  grfMode.l
  grfLocksSupported.l
  clsid.CLSID
  grfStateBits.l
  reserved.l
EndStructure

; https://learn.microsoft.com/en-us/windows/win32/api/shlwapi/nf-shlwapi-shcreatememstream

; IStream * SHCreateMemStream(
;   [in, optional] const BYTE *pInit,
;   [in]           UINT       cbInit
; );
Prototype SHCreateMemStream(*pInit, cbInit)
Global SHCreateMemStream__.SHCreateMemStream

DataSection
  IID_IUnknown:
  Data.l $00000000
  Data.w $0000, $0000
  Data.b $C0, $00, $00, $00, $00, $00, $00, $46
EndDataSection

Structure STRUC_ICoreWebView2CompletedHandler
  *pVtbl
  lRefCount.l
  hEvent.i
  *pValue.Integer
  *pMemStream.IStream
  
  *pQueryInterface
  *pAddRef
  *pRelease
  *pInvoke
EndStructure

Procedure.l CoreWebView2CompletedHandler_QueryInterface(*this.STRUC_ICoreWebView2CompletedHandler, *riid.IID, *ppvObject.Integer)
  If *ppvObject And *riid
    If CompareMemory(*riid, ?IID_IUnknown, SizeOf(IID))
      *this\lRefCount + 1
      *ppvObject\i = *this
      
    Else
      *ppvObject\i = 0
      ProcedureReturn #E_NOINTERFACE
    EndIf
  Else
    ProcedureReturn #E_POINTER
  EndIf
  
  ProcedureReturn #S_OK
EndProcedure

Procedure.l CoreWebView2CompletedHandler_AddRef(*this.STRUC_ICoreWebView2CompletedHandler)
  *this\lRefCount + 1
  ProcedureReturn *this\lRefCount
EndProcedure

Procedure.l CapturePreviewCompletedHandler_Release(*this.STRUC_ICoreWebView2CompletedHandler)
  *this\lRefCount - 1
  If *this\lRefCount <= 0
    FreeMemory(*this)
    ProcedureReturn 0
  EndIf
  ProcedureReturn *this\lRefCount
EndProcedure

Procedure.l CapturePreviewCompletedHandler_Invoke(*this.STRUC_ICoreWebView2CompletedHandler, errorCode.l)
  Protected *buffer, stat.STATSTG, iReadBytes, iImage
  
  If errorCode = #S_OK
    If *this\pMemStream
      If errorCode = #S_OK
        If *this\pMemStream\Stat(@stat, #STATFLAG_NONAME) = #S_OK
          If stat\cbSize > 0
            *buffer = AllocateMemory(stat\cbSize)
            If *buffer
              If *this\pMemStream\Seek(0, #STREAM_SEEK_SET, 0) = #S_OK
                If *this\pMemStream\Read(*buffer, stat\cbSize, @iReadBytes) = #S_OK
                  iImage = CatchImage(#PB_Any, *buffer, iReadBytes)
                  If iImage
                    If *this\pValue
                      *this\pValue\i = iImage
                    EndIf
                  EndIf
                EndIf
              EndIf
              FreeMemory(*buffer)
            EndIf
          EndIf
        EndIf
      EndIf
    EndIf
  EndIf
  
  If *this\pMemStream
    *this\pMemStream\Release()
    *this\pMemStream = 0
  EndIf
  
  If *this\hEvent
    SetEvent_(*this\hEvent)
  EndIf
  
  ProcedureReturn #S_OK
EndProcedure


Procedure.l CoreWebView2ExecuteScriptCompletedHandler_Release(*this.STRUC_ICoreWebView2CompletedHandler)
  *this\lRefCount - 1
  ProcedureReturn *this\lRefCount
EndProcedure

Procedure.l CoreWebView2ExecuteScriptCompletedHandler_Invoke(*this.STRUC_ICoreWebView2CompletedHandler, errorCode.l, *returnObjectAsJson)
  If *returnObjectAsJson
    If errorCode = #S_OK
      ;Debug Val(PeekS(*returnObjectAsJson))
      If *this\pValue
        *this\pValue\i = Val(PeekS(*returnObjectAsJson))
      EndIf
    EndIf
  EndIf
  
  If *this\hEvent
    SetEvent_(*this\hEvent)
  EndIf
  ProcedureReturn #S_OK
EndProcedure

; Return value: 0(Failed), Image number.
Procedure CaptureEdgeWeb(WebGadget)
  Protected Result
  Protected Controller.ICoreWebView2Controller, Core.ICoreWebView2
  Protected *CapturePreviewCompletedHandler.STRUC_ICoreWebView2CompletedHandler
  Protected *CoreWebView2ExecuteScriptCompletedHandler.STRUC_ICoreWebView2CompletedHandler
  Protected hEvent, iValue, w, h, hWnd, rt.RECT
  Protected sClassName.s{64}
  
  If GadgetType(WebGadget) <> #PB_GadgetType_Web Or SHCreateMemStream__ = 0 : ProcedureReturn 0 : EndIf
  
  Controller = GetGadgetAttribute(WebGadget, #PB_WebView_ICoreController)
  If Controller = 0 : Goto Proc_Exit : EndIf
  
  If Controller\get_CoreWebView2(@Core) <> #S_OK Or Core = 0 : Goto Proc_Exit : EndIf
  
  *CoreWebView2ExecuteScriptCompletedHandler = AllocateMemory(SizeOf(STRUC_ICoreWebView2CompletedHandler))
  If *CoreWebView2ExecuteScriptCompletedHandler = 0 : Goto Proc_Exit : EndIf
  
  hEvent = CreateEvent_(0, 0, 0, 0)
  If hEvent = 0 : Goto Proc_Exit : EndIf
  
  With *CoreWebView2ExecuteScriptCompletedHandler
    \pVtbl = *CoreWebView2ExecuteScriptCompletedHandler + OffsetOf(STRUC_ICoreWebView2CompletedHandler\pQueryInterface)
    \pQueryInterface = @CoreWebView2CompletedHandler_QueryInterface()
    \pAddRef = @CoreWebView2CompletedHandler_AddRef()
    \pRelease = @CoreWebView2ExecuteScriptCompletedHandler_Release()
    \pInvoke = @CoreWebView2ExecuteScriptCompletedHandler_Invoke()
    
    \pValue = @iValue
    \hEvent = hEvent
  EndWith
  
  If Core\ExecuteScript("document.body.scrollWidth", *CoreWebView2ExecuteScriptCompletedHandler) = #S_OK
    
    While WaitForSingleObject_(hEvent, 0) <> #WAIT_OBJECT_0
      While WindowEvent() : Wend
    Wend
    
    w = iValue
  EndIf
  
  If Core\ExecuteScript("document.body.scrollHeight", *CoreWebView2ExecuteScriptCompletedHandler) = #S_OK
    
    While WaitForSingleObject_(hEvent, 0) <> #WAIT_OBJECT_0
      While WindowEvent() : Wend
    Wend
    
    h = iValue
  EndIf
  
  FreeMemory(*CoreWebView2ExecuteScriptCompletedHandler)
  *CoreWebView2ExecuteScriptCompletedHandler = 0
  
  If w <= 0 Or h <= 0 : Goto Proc_Exit : EndIf
  
  hWnd = GetWindow_(GadgetID(WebGadget), #GW_CHILD)
  hWnd = GetWindow_(hWnd, #GW_CHILD)
  ;If hWnd = 0 : Goto Proc_Exit : EndIf
  
  GetWindowRect_(hWnd, rt)
  
  GetClassName_(hWnd, @sClassName, 60)
  If sClassName <> "Chrome_WidgetWin_1" : Goto Proc_Exit : EndIf
  
  MoveWindow_(hWnd, 0, 0, w + 20, h, 0)
  While WindowEvent() : Wend
  
  *CapturePreviewCompletedHandler = AllocateMemory(SizeOf(STRUC_ICoreWebView2CompletedHandler))
  If *CapturePreviewCompletedHandler = 0 : Goto Proc_Exit : EndIf
  
  With *CapturePreviewCompletedHandler
    \pVtbl = *CapturePreviewCompletedHandler + OffsetOf(STRUC_ICoreWebView2CompletedHandler\pQueryInterface)
    \pQueryInterface = @CoreWebView2CompletedHandler_QueryInterface()
    \pAddRef = @CoreWebView2CompletedHandler_AddRef()
    \pRelease = @CapturePreviewCompletedHandler_Release()
    \pInvoke = @CapturePreviewCompletedHandler_Invoke()
    
    \pValue = @Result
    \hEvent = hEvent
    \pMemStream = SHCreateMemStream__(0, 0)
    
    If \pMemStream = 0 : Goto Proc_Exit : EndIf
    
    If Core\CapturePreview(#COREWEBVIEW2_CAPTURE_PREVIEW_IMAGE_FORMAT_PNG, \pMemStream, *CapturePreviewCompletedHandler) = #S_OK
      
      While WaitForSingleObject_(hEvent, 0) <> #WAIT_OBJECT_0
        While WindowEvent() : Wend
      Wend
      
      *CapturePreviewCompletedHandler = 0
    EndIf
    
    If *CapturePreviewCompletedHandler
      If \pMemStream : \pMemStream\Release() : EndIf
    EndIf
  EndWith
  
  Core\Release()
  
  Proc_Exit:
  
  If hWnd
    MoveWindow_(hWnd, 0, 0, rt\right - rt\left, rt\bottom - rt\top, 1)
  EndIf
  
  If hEvent : CloseHandle_(hEvent) : EndIf
  If *CoreWebView2ExecuteScriptCompletedHandler : FreeMemory(*CoreWebView2ExecuteScriptCompletedHandler) : EndIf
  If *CapturePreviewCompletedHandler : FreeMemory(*CapturePreviewCompletedHandler) : EndIf
  
  ProcedureReturn Result
EndProcedure

Define Lib_Shlwapi = OpenLibrary(#PB_Any, "Shlwapi.dll")

If Lib_Shlwapi
  SHCreateMemStream__ = GetFunction(Lib_Shlwapi, "SHCreateMemStream")
  If SHCreateMemStream__ = 0
    Debug "error: Cannot get SHCreateMemStream function."
    
    End
    
  EndIf
EndIf


Define e, img

OpenWindow(0, 0, 0, 1030, 730, "", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
ButtonGadget(0, 20, 4, 80, 24, "Capture")
WebGadget(1, 0, 30, 1000, 660, "https://www.purebasic.com", #PB_Web_Edge)

Repeat
  e = WaitWindowEvent()
  
  If e = #PB_Event_Gadget And EventGadget() = 0
    
    img = CaptureEdgeWeb(1)
    
    If img
      ShowLibraryViewer("image", img)
    EndIf
    
  EndIf
  
Until e = #PB_Event_CloseWindow

CloseLibrary(Lib_Shlwapi)

Posted: **Fri Aug 30, 2024 11:10 am**

Great!! This is exactly what I was looking for!

Now I'm just a bit overwhelmed. Which of the methods is the best?

While testing, it seemed as if method1 takes a snapshot directly and method2 ensures that everything is loaded first - seems better to me.

Kind regards

Dige

Posted: **Sat Aug 31, 2024 12:00 pm**

The first code that mentions “New code” is the most recent code. The two capture methods are implemented in one procedure.

The main difference between the two methods is the capture speed.
The method 2 (ICoreWebView2\CapturePreview()) is usually faster.

However, none of the above code waits for the page to fully load, so you might need code like the one below.

Code: Select all

While GetGadgetAttribute( webgadget, #PB_Web_Busy)
  While WindowEvent() : Wend
Wend
img = CaptureEdgeWeb( webgadget )

PureBasic Forums - English

Edge WebGadget capture (Windows)

Edge WebGadget capture (Windows)

Re: Edge WebGadget capture (Windows)

Re: Edge WebGadget capture (Windows)