Snapshot from Url .. how to make threadsafe?
Posted: Tue Sep 24, 2013 11:32 am
With the following code you can make snapshots of websites.
But this needs to run as a thread. Freak told me, the webgadget isnt
threadsafe. But I hope there is a way. Can someone help my?
But this needs to run as a thread. Freak told me, the webgadget isnt
threadsafe. But I hope there is a way. Can someone help my?
Code: Select all
Global mutex, Image
Enumeration
#UrlWnd = 0
#Url_Web = 0
EndEnumeration
Procedure OpenWindow_UrlSnap(Url.s = "about:blank")
OpenWindow(#UrlWnd, 0, 0, 800, 600, "" )
WebGadget(#Url_Web, 0, 0, WindowWidth(#UrlWnd), WindowHeight(#UrlWnd), Url)
SetGadgetAttribute(#Url_Web, #PB_Web_BlockPopups, #TRUE )
SetGadgetAttribute(#Url_Web, #PB_Web_BlockPopupMenu, #TRUE )
m_pWebBrowser.IWebBrowser2 = GetWindowLong_(GadgetID(#Url_Web), #GWL_USERDATA)
If m_pWebBrowser
m_pWebBrowser\put_Silent(#TRUE)
m_pWebBrowser\put_Resizable(#Null)
EndIf
EndProcedure
Procedure GetUrlSnapShot(WebGadgetID.i)
Define.IWebBrowser2 m_pWebBrowser
Define.IHTMLDocument2 pDocument
Define.IHTMLDocument3 pDocument3
Define.IHTMLElement pElement
Define.IHTMLElement2 pElement2
Define.iDispatch pDispatch
Define.IViewObject2 pViewObject
LockMutex(mutex)
Url.s = "http://www.purebasic.com"
Define.l bodyHeight, bodyWidth, rootHeight
Define.RECT rcBounds
If WebGadgetID & $80000000
flags = #Null
WebGadgetID & ~$80000000
Else
flags = #TRUE
EndIf
SetGadgetText(WebGadgetID, Url)
TimeOut = 15000 + ElapsedMilliseconds()
Repeat
Delay(1000)
If Not GetGadgetAttribute(WebGadgetID, #PB_Web_Busy)
TimeOut = #Null
Break
Else
Debug "busy"
EndIf
If TimeOut < ElapsedMilliseconds()
Break
EndIf
If flags ; if its called not as thread
While WindowEvent() : Wend
EndIf
ForEver
m_pWebBrowser = GetWindowLong_(GadgetID(WebGadgetID), #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
hr = pElement\QueryInterface(?IID_IHTMLElement2, @pElement2)
If hr=#S_OK
hr = pElement2\get_scrollHeight(@rootHeight)
If hr = #S_OK
hr = pElement2\get_scrollWidth(@rootWidth)
EndIf
EndIf
EndIf
If hr<>#S_OK
UnlockMutex(mutex)
ProcedureReturn #False
EndIf
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, bodyWidth, bodyHeight)
If hBitmap
Define.l oldImage
oldImage = SelectObject_(HdcMem, hBitmap)
rcBounds\top = 0
rcBounds\left = 0
rcBounds\right = bodyWidth
rcBounds\bottom = bodyHeight
pViewObject\Draw(#DVASPECT_CONTENT, -1, 0, 0, hdcMain, HdcMem, rcBounds, 0, 0, 0)
Image = CreateImage(#PB_Any, bodyWidth, bodyHeight)
If Image
Define.l img_hDC
img_hDC = StartDrawing(ImageOutput(Image))
If img_hDC
BitBlt_(img_hDC, 0, 0, bodyWidth, bodyHeight, HdcMem, 0, 0, #SRCCOPY)
StopDrawing()
EndIf
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
UnlockMutex(mutex)
ProcedureReturn Image
EndProcedure
mutex = CreateMutex()
OpenWindow_UrlSnap()
; Run as Main Task .. OK
Image = GetUrlSnapShot(#Url_Web)
MessageRequester( "Result Main", Str(Image))
Image = 0
; Run as Thread crashes ...
CreateThread(@GetUrlSnapShot(), #Url_Web|$80000000)
Repeat
While WindowEvent() : Wend
Until TryLockMutex(mutex)
MessageRequester( "Result Thread", Str(Image))
If Image <> 0
SaveImage( Image, GetTemporaryDirectory() + "Snap.bmp", #PB_ImagePlugin_BMP )
RunProgram(GetTemporaryDirectory() + "Snap.bmp")
EndIf
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 ;}
