It is currently Thu Dec 12, 2019 4:58 am

All times are UTC + 1 hour




Post new topic Reply to topic  [ 10 posts ] 
Author Message
 Post subject: How to do a full website snapshot?
PostPosted: Thu Nov 27, 2008 8:53 am 
Offline
Addict
Addict
User avatar

Joined: Wed Apr 30, 2003 8:15 am
Posts: 990
Location: Germany
In most cases, the rendered website is bigger than the visible window and
a snapshot shots only a part of the page.

Is there an interface through the webgadget to catch the full image. or any
other ideas?

for example there is a nice tool called webshot ( http://www.websitescreenshots.com )


Top
 Profile  
Reply with quote  
 Post subject: Re: How to do a full website snapshot?
PostPosted: Thu Nov 27, 2008 11:49 am 
Offline
PureBasic Expert
PureBasic Expert

Joined: Fri Apr 25, 2003 5:24 pm
Posts: 7581
Sparkie knows how to do it but he never released the code. ;)

_________________
I compile using 5.31 (x86) on Win 7 Ultimate (64-bit).
"PureBasic won't be object oriented, period" - Fred.


Top
 Profile  
Reply with quote  
 Post subject:
PostPosted: Thu Nov 27, 2008 1:38 pm 
Offline
Addict
Addict
User avatar

Joined: Tue May 08, 2007 1:27 pm
Posts: 2721
Location: Chiba, Japan
I wonder if there is a way to send it to a "printer" in the same way Print-to-PDF kinds of drivers work but drop it as a PNG

I agree though, Sparkie or Netmaestro will probably have a way to hook in and grap the screen :P

_________________
Paul Dwyer

“In nature, it’s not the strongest nor the most intelligent who survives. It’s the most adaptable to change” - Charles Darwin
“If you can't explain it to a six-year old you really don't understand it yourself.” - Albert Einstein


Top
 Profile  
Reply with quote  
 Post subject: Re: How to do a full website snapshot?
PostPosted: Thu Nov 27, 2008 2:44 pm 
Offline
Addict
Addict
User avatar

Joined: Tue Mar 02, 2004 1:20 pm
Posts: 1033
Location: Amphibios 9
dige wrote:
Is there an interface through the webgadget to catch the full image. or any other ideas?

here is my source (posted 2006 in the german forum)
Code:
EnableExplicit

Enumeration
  #frmSnapShot
  #frmSnapShot_WB
EndEnumeration

Enumeration
  #DVASPECT_CONTENT    = 1
  #DVASPECT_THUMBNAIL  = 2
  #DVASPECT_ICON       = 4
  #DVASPECT_DOCPRINT   = 8
EndEnumeration

Procedure.l TakeWebSnapshot(URL$, WBWidth.l, WBHeight.l, Filename$, ThumbWidth.l, ThumbHeight.l, ThumbRatio.f)
 
  Define.IWebBrowser2   m_pWebBrowser
 
  Define.IHTMLDocument2 pDocument
  Define.IHTMLDocument3 pDocument3
  Define.IHTMLElement   pElement
  Define.IHTMLElement2  pElement2
  Define.iDispatch      pDispatch
  Define.IViewObject2   pViewObject
 
  Define.l bodyHeight
  Define.l bodyWidth
  Define.l rootHeight
  Define.l rootWidth
 
  Define.RECT rcBounds
 
  Define.l bolFlag
  Define.l IsBusy
  Define.l hr
 
  bolFlag = #False
 
  If OpenWindow(#frmSnapShot, 0, 0, 0, 0, "", #PB_Window_Invisible | #PB_Window_BorderLess)
   
    If CreateGadgetList(WindowID(#frmSnapShot))
     
      WebGadget(#frmSnapShot_WB, 0, 0, 0, 0, URL$)
     
      Repeat
        If GetGadgetAttribute(#frmSnapShot_WB, #PB_Web_Busy) = 0
          Break
        EndIf
       
        While WindowEvent(): Delay(1) : Wend
      ForEver
     
      m_pWebBrowser = GetWindowLong_(GadgetID(#frmSnapShot_WB), #GWL_USERDATA)
     
      ; hr = m_pWebBrowser->get_Document(&pDispatch);
      hr = m_pWebBrowser\get_document(@pDispatch)
      If hr = #S_OK
        If pDispatch
         
          ; hr = pDispatch->QueryInterface(IID_IHTMLDocument2, (void**)&pDocument);
          hr = pDispatch\QueryInterface(?IID_IHTMLDocument2, @pDocument)
          If hr = #S_OK
            If pDocument
             
              ; hr = pDocument->get_body(&pElement);
              hr = pDocument\get_body(@pElement)
              If hr = #S_OK
                If pElement
                 
                  ; hr = pElement->QueryInterface(IID_IHTMLElement2, (void**)&pElement2);
                  hr = pElement\QueryInterface(?IID_IHTMLElement2, @pElement2)
                  If hr = #S_OK
                    If pElement2
                     
                      ; hr = pElement2->get_scrollHeight(&bodyHeight);
                      hr = pElement2\get_scrollHeight(@bodyHeight)
                      If hr = #S_OK
                       
                        Debug "bodyHeight: " + Str(bodyHeight)
                       
                        ; hr = pElement2->get_scrollWidth(&bodyWidth);
                        hr = pElement2\get_scrollWidth(@bodyWidth)
                        If hr = #S_OK
                         
                          Debug "bodyWidth: " + Str(bodyWidth)
                         
                          ; hr = pDispatch->QueryInterface(IID_IHTMLDocument3, (void**)&pDocument3);
                          hr = pDispatch\QueryInterface(?IID_IHTMLDocument3, @pDocument3)
                          If hr = #S_OK
                            If pDocument3
                             
                              ; hr = pDocument3->get_documentElement(&pElement);
                              hr = pDocument3\get_documentElement(@pElement)
                              If hr <> #S_OK : ProcedureReturn #False : EndIf
                             
                              ; hr = pElement->QueryInterface(IID_IHTMLElement2, (void**)&pElement2);
                              hr = pElement\QueryInterface(?IID_IHTMLElement2, @pElement2)
                              If hr <> #S_OK : ProcedureReturn #False : EndIf
                             
                              ; hr = pElement2->get_scrollHeight(&rootHeight);
                              hr = pElement2\get_scrollHeight(@rootHeight)
                              If hr <> #S_OK : ProcedureReturn #False : EndIf
                             
                              Debug "rootHeight: " + Str(rootHeight)
                             
                              ; hr = pElement2->get_scrollWidth(&rootWidth);
                              hr = pElement2\get_scrollWidth(@rootWidth)
                              If hr <> #S_OK : ProcedureReturn #False : EndIf
                             
                              Debug "rootWidth: " + Str(rootWidth)
                             
                              Define.l width
                              Define.l height
                             
                              width = bodyWidth
                              ; If rootWidth > bodyWidth : Width = rootWidth : EndIf
                             
                              height = bodyHeight
                              ; If rootHeight > bodyHeight : Height = rootHeight : EndIf
                             
                              width + 22
                             
                              If WBHeight > 0 : height = WBHeight : EndIf
                             
                              If WBWidth > 0 : width = WBWidth : EndIf
                             
                              ResizeGadget(#frmSnapShot_WB, 0, 0, width, height)
                             
                              ; hr = m_pWebBrowser->QueryInterface(IID_IViewObject2, (void**)&pViewObject);
                              hr = m_pWebBrowser\QueryInterface(?IID_IViewObject2, @pViewObject)
                              If hr = #S_OK
                                If pViewObject
                                 
                                  Define.l hdcMain
                                 
                                  hdcMain = GetDC_(0)
                                  If hdcMain
                                   
                                    Define.l hdcMem
                                   
                                    hdcMem  = CreateCompatibleDC_(hdcMain)
                                    If hdcMem
                                     
                                      Define.l hBitmap
                                     
                                      hBitmap = CreateCompatibleBitmap_(hdcMain, width, height)
                                      If hBitmap
                                       
                                        Define.l oldImage
                                       
                                        oldImage = SelectObject_(hdcMem, hBitmap)
                                       
                                        rcBounds\top = 0
                                        rcBounds\left = 0
                                        rcBounds\right = width
                                        rcBounds\bottom = height
                                       
                                        pViewObject\Draw(#DVASPECT_CONTENT, -1, 0, 0, hdcMain, hdcMem, rcBounds, 0, 0, 0)
                                       
                                        Define.l Image
                                       
                                        Image = CreateImage(#PB_Any, width, height)
                                        If Image
                                         
                                          Define.l img_hDC
                                         
                                          img_hDC = StartDrawing(ImageOutput(Image))
                                            If img_hDC
                                              BitBlt_(img_hDC, 0, 0, width, height, hdcMem, 0, 0, #SRCCOPY)
                                            StopDrawing()
                                            If ThumbRatio > 0
                                              ResizeImage(Image, width*ThumbRatio, height*ThumbRatio, #PB_Image_Smooth)
                                            Else
                                              ResizeImage(Image, ThumbWidth, ThumbHeight, #PB_Image_Smooth)
                                            EndIf
                                            SaveImage(Image,Filename$,#PB_ImagePlugin_BMP)
                                            bolFlag = #True
                                          EndIf ; img_hDC
                                          FreeImage(Image)
                                        EndIf ; Image
                                       
                                        SelectObject_(hdcMem, oldImage)
                                       
                                      EndIf ; hBitmap
                                     
                                      DeleteDC_(hdcMem) ; DeleteDC_() bei CreateCompatibleDC_()
                                    EndIf ; hdcMem
                                   
                                    ReleaseDC_(0, hdcMain) ; ReleaseDC_() bei GetDC_()
                                  EndIf ; hdcMain
                                 
                                  pViewObject\Release()
                                EndIf ; pViewObject
                              EndIf; HR
                             
                              pDocument3\Release()
                            EndIf ; pDocument3
                          EndIf ; HR
                         
                        EndIf ; HR
                       
                      EndIf ; HR
                     
                      pElement2\Release()
                    EndIf ; pElement2
                  EndIf ; HR
                 
                  pElement\Release()
                EndIf ; pElement
              EndIf ; HR
             
              pDocument\Release()
            EndIf ; pDocument
          EndIf ; HR
         
          pDispatch\Release()
        EndIf ; pDispatch
      EndIf ; HR
     
      CloseWindow(#frmSnapShot)
     
    EndIf
  EndIf
 
  ProcedureReturn bolFlag
 
EndProcedure

Procedure TakeWebSnapshot_test()
 
  Define.s URL$
  Define.s SaveAs$
  Define.f ResizeFaktor
 
  Define.l WBWidth
  Define.l WBHeight
 
  URL$           = "http://www.purebasic.com"
  SaveAs$        = "c:\webshot.bmp"         
  ResizeFaktor.f = 0.5                       
 
  If ResizeFaktor = 0 : ResizeFaktor = 1.0 : EndIf
  If ResizeFaktor < 0 : ResizeFaktor = 0.1 : EndIf
  If ResizeFaktor > 2 : ResizeFaktor = 2.0 : EndIf
 
  ExamineDesktops()
  WBWidth = DesktopWidth(0)
  WBHeight = DesktopHeight(0)
 
  If TakeWebSnapshot(URL$, WBWidth, WBHeight, SaveAs$, 0, 0, ResizeFaktor)
    RunProgram(SaveAs$)
  Else
    MessageRequester("WebShot", "TakeWebSnapshot() failed")
  EndIf
 
EndProcedure

TakeWebSnapshot_test()

End


DataSection ;{
 
  IID_IHTMLDocument2:
  ;332C4425-26CB-11D0-B483-00C04FD90119
  Data.l $332C4425
  Data.w $26CB, $11D0
  Data.b $B4, $83, $00, $C0, $4F, $D9, $01, $19
 
  IID_IHTMLDocument3:
  ;3050F485-98B5-11CF-BB82-00AA00BDCE0B
  Data.l $3050F485
  Data.w $98B5, $11CF
  Data.b $BB, $82, $00, $AA, $00, $BD, $CE, $0B
 
  IID_IHTMLElement2:
  ;3050f434-98b5-11cf-bb82-00aa00bdce0b
  Data.l $3050F434
  Data.w $98B5, $11CF
  Data.b $BB, $82, $00, $AA, $00, $BD, $CE, $0B
 
  IID_IViewObject2:
  ;00000127-0000-0000-c000-000000000046
  Data.l $00000127
  Data.w $0000, $0000
  Data.b $C0, $00, $00, $00, $00, $00, $00, $46
 
 
EndDataSection ;}


Greetings ... Kiffi

_________________
Can't decide if i need a hug, an XXL coffee, 6 shots of vodka or 2 weeks of sleep.


Top
 Profile  
Reply with quote  
 Post subject: Re: How to do a full website snapshot?
PostPosted: Thu Nov 27, 2008 2:51 pm 
Offline
PureBasic Expert
PureBasic Expert

Joined: Fri Apr 25, 2003 5:24 pm
Posts: 7581
> here is my source (posted 2006 in the german forum)

Doesn't work with long web pages (they get truncated here).

_________________
I compile using 5.31 (x86) on Win 7 Ultimate (64-bit).
"PureBasic won't be object oriented, period" - Fred.


Top
 Profile  
Reply with quote  
 Post subject: Re: How to do a full website snapshot?
PostPosted: Thu Nov 27, 2008 3:04 pm 
Offline
Addict
Addict
User avatar

Joined: Tue Mar 02, 2004 1:20 pm
Posts: 1033
Location: Amphibios 9
PB wrote:
Doesn't work with long web pages (they get truncated here).

yes, you're right. Please replace the following code:

before (buggy):
Code:
width = bodyWidth
; If rootWidth > bodyWidth : Width = rootWidth : EndIf

height = bodyHeight
; If rootHeight > bodyHeight : Height = rootHeight : EndIf

width + 22

If WBHeight > 0 : height = WBHeight : EndIf
If WBWidth > 0 : width = WBWidth : EndIf

ResizeGadget(#frmSnapShot_WB, 0, 0, width, height)


after (correct):
Code:
width = bodyWidth
If rootWidth > bodyWidth : width= rootWidth : EndIf

height = bodyHeight
If rootHeight > bodyHeight : height= rootHeight : EndIf

width + 22

; If WBHeight > 0 : height = WBHeight : EndIf
; If WBWidth > 0 : width = WBWidth : EndIf

ResizeGadget(#frmSnapShot_WB, 0, 0, width, height)


Greetings ... Kiffi

_________________
Can't decide if i need a hug, an XXL coffee, 6 shots of vodka or 2 weeks of sleep.


Top
 Profile  
Reply with quote  
 Post subject:
PostPosted: Thu Nov 27, 2008 3:50 pm 
Offline
Addict
Addict
User avatar

Joined: Sun Nov 05, 2006 11:42 pm
Posts: 4545
Location: Lyon - France
It's GREAT KIFFI
Works fine with a big page 8)

_________________
ImageThe happiness is a road...
Not a destination


Top
 Profile  
Reply with quote  
 Post subject:
PostPosted: Fri Nov 28, 2008 8:31 am 
Offline
Addict
Addict
User avatar

Joined: Wed Apr 30, 2003 8:15 am
Posts: 990
Location: Germany
Rock'n Roll! :D Kiffi - thats great .. thank you very much!!!!


Top
 Profile  
Reply with quote  
 Post subject:
PostPosted: Fri Nov 28, 2008 11:12 am 
Offline
Moderator
Moderator
User avatar

Joined: Sat Apr 26, 2003 1:11 am
Posts: 1390
amazing, gives me more options....

_________________
SPAMINATOR NR.1


Top
 Profile  
Reply with quote  
 Post subject: Re: How to do a full website snapshot?
PostPosted: Sun Feb 08, 2009 4:44 am 
Offline
PureBasic Expert
PureBasic Expert

Joined: Fri Apr 25, 2003 5:24 pm
Posts: 7581
@Kiffi: Your code is good, but I've found it saves images with too much
height a lot of the time. For example, try the following with Wikipedia's
entry for PureBasic: it says the height is 16001! :shock: And thus fails. Are
you able to work out how to get the actual height of the web page?
I've tried but haven't been successful. Would be good to solve this.

Code:
Enumeration
  #frmSnapShot
  #frmSnapShot_WB
EndEnumeration

Enumeration
  #DVASPECT_CONTENT    = 1
  #DVASPECT_THUMBNAIL  = 2
  #DVASPECT_ICON       = 4
  #DVASPECT_DOCPRINT   = 8
EndEnumeration

Procedure.l TakeWebSnapshot(URL$, WBWidth.l, WBHeight.l, Filename$, ThumbWidth.l, ThumbHeight.l)

  Define.IWebBrowser2   m_pWebBrowser

  Define.IHTMLDocument2 pDocument
  Define.IHTMLDocument3 pDocument3
  Define.IHTMLElement   pElement
  Define.IHTMLElement2  pElement2
  Define.iDispatch      pDispatch
  Define.IViewObject2   pViewObject

  Define.l bodyHeight
  Define.l bodyWidth
  Define.l rootHeight
  Define.l rootWidth

  Define.RECT rcBounds

  Define.l bolFlag
  Define.l IsBusy
  Define.l hr

  bolFlag = #False

  If OpenWindow(#frmSnapShot, 0, 0, 0, 0, "", #PB_Window_Invisible | #PB_Window_BorderLess)

      WebGadget(#frmSnapShot_WB, 0, 0, 0, 0, URL$)

      Repeat
        If GetGadgetAttribute(#frmSnapShot_WB, #PB_Web_Busy) = 0
          Break
        EndIf

        While WindowEvent(): Delay(1) : Wend
      ForEver

      m_pWebBrowser = GetWindowLong_(GadgetID(#frmSnapShot_WB), #GWL_USERDATA)

      hr = m_pWebBrowser\get_document(@pDispatch)
      If hr = #S_OK
        If pDispatch

          hr = pDispatch\QueryInterface(?IID_IHTMLDocument2, @pDocument)
          If hr = #S_OK
            If pDocument

              hr = pDocument\get_body(@pElement)
              If hr = #S_OK
                If pElement

                  hr = pElement\QueryInterface(?IID_IHTMLElement2, @pElement2)
                  If hr = #S_OK
                    If pElement2

                      hr = pElement2\get_scrollHeight(@bodyHeight)
                      If hr = #S_OK

                        hr = pElement2\get_scrollWidth(@bodyWidth)
                        If hr = #S_OK

                          hr = pDispatch\QueryInterface(?IID_IHTMLDocument3, @pDocument3)
                          If hr = #S_OK
                            If pDocument3

                              hr = pDocument3\get_documentElement(@pElement)
                              If hr <> #S_OK : ProcedureReturn #False : EndIf

                              hr = pElement\QueryInterface(?IID_IHTMLElement2, @pElement2)
                              If hr <> #S_OK : ProcedureReturn #False : EndIf

                              hr = pElement2\get_scrollHeight(@rootHeight)
                              If hr <> #S_OK : ProcedureReturn #False : EndIf

                              hr = pElement2\get_scrollWidth(@rootWidth)
                              If hr <> #S_OK : ProcedureReturn #False : EndIf

                              Define.l width
                              Define.l height

                              width = 1024 ; bodyWidth

                              height = bodyHeight

                              If rootHeight > bodyHeight : height= rootHeight : EndIf

                              Debug height ; Shows 16001 which is far too big!

                              ResizeGadget(#frmSnapShot_WB, 0, 0, width, height)

                              hr = m_pWebBrowser\QueryInterface(?IID_IViewObject2, @pViewObject)
                              If hr = #S_OK
                                If pViewObject

                                  Define.l hdcMain

                                  hdcMain = GetDC_(0)
                                  If hdcMain

                                    Define.l hdcMem

                                    hdcMem  = CreateCompatibleDC_(hdcMain)
                                    If hdcMem

                                      Define.l hBitmap

                                      hBitmap = CreateCompatibleBitmap_(hdcMain, width, height)
                                      If hBitmap

                                        Define.l oldImage

                                        oldImage = SelectObject_(hdcMem, hBitmap)

                                        rcBounds\top = 0
                                        rcBounds\left = 0
                                        rcBounds\right = width
                                        rcBounds\bottom = height

                                        pViewObject\Draw(#DVASPECT_CONTENT, -1, 0, 0, hdcMain, hdcMem, rcBounds, 0, 0, 0)

                                        Define.l Image

                                        Image = CreateImage(#PB_Any, width, height)
                                        If Image

                                          Define.l img_hDC

                                          img_hDC = StartDrawing(ImageOutput(Image))
                                            If img_hDC
                                              BitBlt_(img_hDC, 0, 0, width, height, hdcMem, 0, 0, #SRCCOPY)
                                            StopDrawing()
                                            SaveImage(Image,Filename$,#PB_ImagePlugin_BMP)
                                            bolFlag = #True
                                          EndIf
                                          FreeImage(Image)
                                        EndIf

                                        SelectObject_(hdcMem, oldImage)

                                      EndIf

                                      DeleteDC_(hdcMem)
                                    EndIf

                                    ReleaseDC_(0, hdcMain)
                                  EndIf

                                  pViewObject\Release()
                                EndIf
                              EndIf

                              pDocument3\Release()
                            EndIf
                          EndIf

                        EndIf

                      EndIf

                      pElement2\Release()
                    EndIf
                  EndIf

                  pElement\Release()
                EndIf
              EndIf

              pDocument\Release()
            EndIf
          EndIf

          pDispatch\Release()
        EndIf
      EndIf

      CloseWindow(#frmSnapShot)

    EndIf

  ProcedureReturn bolFlag

EndProcedure

Procedure TakeWebSnapshot_test()

  Define.s URL$
  Define.s SaveAs$
  Define.f ResizeFaktor

  Define.l WBWidth
  Define.l WBHeight

  URL$           = "http://en.wikipedia.org/wiki/PureBasic"
  SaveAs$        = "c:\webshot.bmp"

  ExamineDesktops()
  WBWidth = DesktopWidth(0)
  WBHeight = DesktopHeight(0)

  If TakeWebSnapshot(URL$, WBWidth, WBHeight, SaveAs$, 0, 0)
    RunProgram(SaveAs$)
  Else
    MessageRequester("WebShot", "TakeWebSnapshot() failed")
  EndIf

EndProcedure

TakeWebSnapshot_test()

End

DataSection ;{

  IID_IHTMLDocument2:
  ;332C4425-26CB-11D0-B483-00C04FD90119
  Data.l $332C4425
  Data.w $26CB, $11D0
  Data.b $B4, $83, $00, $C0, $4F, $D9, $01, $19

  IID_IHTMLDocument3:
  ;3050F485-98B5-11CF-BB82-00AA00BDCE0B
  Data.l $3050F485
  Data.w $98B5, $11CF
  Data.b $BB, $82, $00, $AA, $00, $BD, $CE, $0B

  IID_IHTMLElement2:
  ;3050f434-98b5-11cf-bb82-00aa00bdce0b
  Data.l $3050F434
  Data.w $98B5, $11CF
  Data.b $BB, $82, $00, $AA, $00, $BD, $CE, $0B

  IID_IViewObject2:
  ;00000127-0000-0000-c000-000000000046
  Data.l $00000127
  Data.w $0000, $0000
  Data.b $C0, $00, $00, $00, $00, $00, $00, $46

EndDataSection ;}

_________________
I compile using 5.31 (x86) on Win 7 Ultimate (64-bit).
"PureBasic won't be object oriented, period" - Fred.


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 10 posts ] 

All times are UTC + 1 hour


Who is online

Users browsing this forum: No registered users and 11 guests


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum

Search for:
Jump to:  

 


Powered by phpBB © 2008 phpBB Group
subSilver+ theme by Canver Software, sponsor Sanal Modifiye