PureBasic Forums - English

Code: Select all

;Webbrowser2
;no error checking
;Justin 08/2004

;- #CONSTANTS
#DISPID_READYSTATE = -525

enumeration
	#READYSTATE_UNINITIALIZED ;0
	#READYSTATE_LOADING ;1
	#READYSTATE_LOADED ;2
	#READYSTATE_INTERACTIVE ;3
 	#READYSTATE_COMPLETE ;4
endenumeration 

;- #STRUCTURES
Structure VARIANT
  vt.w
  wReserved1.w
  wReserved2.w
  wReserved3.w
  structureunion
  	bstrVal.l			;BSTR		VT_BSTR
  endstructureunion
EndStructure

;- #GLOBALS
Global gpBrowser.IWebbrowser2, ghwST, ghwBT, ghwED

Declare MainWndProc(hwnd, msg, wParam, lParam)

;Declare a COM Object(ReadyStateObj) that exposes the IPropertyNotifySink interface
interface IReadyState
	;IPropertyNotifySink functions
  RS_QueryInterface(*iid.GUID, *Object.LONG)
  RS_AddRef()
  RS_Release()
	RS_OnChanged(dispID) 
	RS_OnRequestEdit(dispID)
endinterface

Structure ReadyStateFunctions
  RS_QueryInterface.l 
  RS_AddRef.l 
  RS_Release.l 
	RS_OnChanged.l  
	RS_OnRequestEdit.l 
EndStructure 

Structure ReadyStateObj
  *IPropertyNotifySink.ReadyStateFunctions 
  
	 ObjectCount.l 
EndStructure 

Procedure.l RS_AddRef(*THIS.ReadyStateObj) 
  *THIS\ObjectCount + 1 
  ProcedureReturn *THIS\ObjectCount 
EndProcedure 

Procedure.l RS_QueryInterface(*THIS.ReadyStateObj, *iid.GUID, *Object.LONG) 
  If CompareMemory(*iid, ?IID_IUnknown, SizeOf(GUID)) Or CompareMemory(*iid, ?IID_IPropertyNotifySink, SizeOf(GUID)) 
    *Object\l = *THIS  
    RS_AddRef(*THIS.ReadyStateObj)  
    ProcedureReturn #S_OK 
  Else    
    *Object\l = 0 
    ProcedureReturn #E_NOINTERFACE 
  EndIf 
EndProcedure 

Procedure.l RS_Release(*THIS.ReadyStateObj) 
  *THIS\ObjectCount - 1 
  ProcedureReturn *THIS\ObjectCount 
EndProcedure 

Procedure RS_OnChanged(*THIS.ReadyStateObj, dispID)
	If dispID = #DISPID_READYSTATE
		gpBrowser\get_readyState(@state)
		Select state
			Case #READYSTATE_UNINITIALIZED
				setwindowtext_(ghwST, "Status: UNINITIALIZED")
				
			Case #READYSTATE_LOADING
				setwindowtext_(ghwST, "Status: LOADING")

			Case #READYSTATE_LOADED
				setwindowtext_(ghwST, "Status: LOADED")

			Case #READYSTATE_INTERACTIVE
				setwindowtext_(ghwST, "Status: INTERACTIVE")

 			Case #READYSTATE_COMPLETE
				setwindowtext_(ghwST, "Status: COMPLETE")
		EndSelect 
	EndIf 
	ProcedureReturn #S_OK
EndProcedure 

Procedure RS_OnRequestEdit(*THIS.ReadyStateObj, dispID)
	ProcedureReturn #S_OK 
EndProcedure 

ReadyStateFunctions.ReadyStateFunctions\RS_QueryInterface = @RS_QueryInterface() 
ReadyStateFunctions.ReadyStateFunctions\RS_AddRef = @RS_AddRef() 
ReadyStateFunctions.ReadyStateFunctions\RS_Release = @RS_Release() 
ReadyStateFunctions.ReadyStateFunctions\RS_OnChanged = @RS_OnChanged() 
ReadyStateFunctions.ReadyStateFunctions\RS_OnRequestEdit = @RS_OnRequestEdit() 

ReadyStateObj.ReadyStateObj\IPropertyNotifySink = ReadyStateFunctions
;END DECLARING OBJECT

;CODE START
hinst = getmodulehandle_(0)

hatl = OpenLibrary(#PB_Any, "atl.dll")

CallFunction(hatl, "AtlAxWinInit")

;register class
wc.WNDCLASSEX
wc\cbSize        = SizeOf(WNDCLASSEX)
wc\style         = #CS_HREDRAW|#CS_VREDRAW
wc\lpfnWndProc   = @MainWndProc()
;	wc\cbClsExtra    = 0
;	wc\cbWndExtra    = 0
wc\hInstance     = HINST
;	wc\hIcon         = 0 
wc\hCursor       = LoadCursor_(#NULL, #IDC_ARROW)
wc\hbrBackground = GetSysColorBrush_(#COLOR_WINDOW)
wc\lpszMenuName  = #NULL
wc\lpszClassName = @"myWindowClass"
;wc\hIconSm       = 0
RegisterClassEx_(@wc)

hwMain = CreateWindowEx_(0, "myWindowClass", "Webbrowser Test", #WS_OVERLAPPEDWINDOW, 10, 10, 567, 322, #HWND_DESKTOP, #NULL, hinst, #NULL)
ghwED = CreateWindowEx_(#WS_EX_CLIENTEDGE, "Edit", "", #WS_CHILD|#WS_VISIBLE, 10, 8, 190, 24, hwMain, #NULL, hinst, #NULL)
ghwBT = CreateWindowEx_(0, "Button", "Go", #WS_CHILD|#WS_VISIBLE, 210, 8, 60, 24, hwMain, #NULL, hinst, #NULL)
ghwST = CreateWindowEx_(0, "Static", "Status:", #WS_CHILD|#WS_VISIBLE, 10, 260, 260, 24, hwMain, #NULL, hinst, #NULL)

;create ready state object
pRS.IReadyState = @ReadyStateObj 

;create browser window
hwBrowser = CreateWindowex_(#WS_EX_CLIENTEDGE, "AtlAxWin", "Shell.Explorer.1", #WS_CHILD|#WS_VISIBLE, 10, 40, 260, 210, hwMain, 0, hinst, #NULL)

;get browser object
CallFunction(hatl, "AtlAxGetControl", hwBrowser, @pUnk.IUnknown)
pUnk\QueryInterface(?IID_IWebBrowser2, @gpBrowser) 

;Hook up sink to catch ready state property change
gpBrowser\QueryInterface(?IID_IConnectionPointContainer, @pCPC.IConnectionPointContainer)
pCPC\FindConnectionPoint(?IID_IPropertyNotifySink, @pCP.IConnectionPoint)
pCP\Advise(pRS, @Cookie)

ShowWindow_(hwMain, #SW_SHOWNORMAL)

;msg loop
msgs.MSG
While GetMessage_(@msgs, 0, 0, 0)
	TranslateMessage_(@msgs)
	DispatchMessage_(@msgs)
Wend

;free
gpBrowser\Release()
pCPC\Release()
pCP\Release()
pRS\RS_Release()
CloseLibrary(hatl)
End 

Procedure MainWndProc(hwnd, msg, wParam, lParam)
	Select msg
;- WM_COMMAND
		Case #WM_COMMAND
			Select lParam
;- NAVIGATE
				Case ghwBT
					url$ = Space(#MAX_PATH)
					GetWindowText_(ghwED, @url$, #MAX_PATH)
					If url$<>""
  					wbuf = AllocateMemory(1000)
  					MultiByteToWideChar_(#CP_ACP, 0, url$, -1, wbuf, 1000)
  					var.VARIANT
  					var\vt = #VT_BSTR  
  					var\bstrVal = wbuf
  					gpBrowser\Navigate2(@var, 0,0,0,0)		
  					FreeMemory(wbuf)			
					EndIf 		
			EndSelect 
			ProcedureReturn 0

;- WM_DESTROY
		Case #WM_DESTROY
			PostQuitMessage_(0)
       
		Default
			ProcedureReturn DefWindowProc_(hwnd, msg, wParam, lParam)
	EndSelect 
	ProcedureReturn 0
EndProcedure 

;- #DATA
DataSection
	IID_IWebBrowser2:
	Data.l $D30C1661
	Data.w $CDAF, $11d0
	Data.b $8A, $3E, $00, $C0, $4F, $C9, $E2, $6E
	
	IID_IConnectionPointContainer:
	Data.l $B196B284
	Data.w $BAB4, $101A
	Data.b $B6, $9C, $00, $AA, $00, $34, $1D, $07	
	
	IID_IPropertyNotifySink:
	Data.l $9BFBBC02
	Data.w $EFF1, $101A
	Data.b $84, $ED, $00, $AA, $00, $34, $1D, $07		
	
	IID_IUnknown:  
	Data.l $00000000 
	Data.w $0000, $0000 
	Data.b $C0, $00, $00, $00, $00, $00, $00, $46
EndDataSection 

Code: Select all

structure GUID
Data1.l
Data2.w
Data3.w
Data4.b[8]
endstructure