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 )
How to do a full website snapshot?
Re: How to do a full website snapshot?
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.
"PureBasic won't be object oriented, period" - Fred.
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
I agree though, Sparkie or Netmaestro will probably have a way to hook in and grap the screen
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
“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
Re: How to do a full website snapshot?
here is my source (posted 2006 in the german forum)dige wrote:Is there an interface through the webgadget to catch the full image. or any other ideas?
Code: Select all
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 ;}Hygge
Re: How to do a full website snapshot?
> here is my source (posted 2006 in the german forum)
Doesn't work with long web pages (they get truncated here).
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.
"PureBasic won't be object oriented, period" - Fred.
Re: How to do a full website snapshot?
yes, you're right. Please replace the following code:PB wrote:Doesn't work with long web pages (they get truncated here).
before (buggy):
Code: Select all
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) Code: Select all
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)Hygge
-
Kwai chang caine
- Always Here
- Posts: 5353
- Joined: Sun Nov 05, 2006 11:42 pm
- Location: Lyon - France
Kiffi - thats great .. thank you very much!!!!
Re: How to do a full website snapshot?
@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!
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.
height a lot of the time. For example, try the following with Wikipedia's
entry for PureBasic: it says the height is 16001!
And thus fails. Areyou 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: Select all
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.
"PureBasic won't be object oriented, period" - Fred.