Web browser from vbscript

Post by **Richard Naninck** » Thu Jan 25, 2007 6:19 pm

I have seen Oslers posts about the Web browser and figured I already had my browser script posted a long time ago. I guess I didn't because I can't find it in the scripts section.

So here it is. A theme control example, the HB setup and a screenshot. At least it will give some ideas bout how to get a browser going from vbscript.

Obviously I could create an export, but it seems Osler is doing a great job already.

Post by **Richard Naninck** » Thu Jan 25, 2007 6:24 pm

For some reason the script didn't attach to the above posting. Here it is.

Code: Select all

'Internet Browser

Option Explicit
On Error Resume Next

Dim Action
Dim Status
Dim objIE
Dim FavCount_1
Dim FavCount_2
Dim FavCount_3
Dim FavCount_4
Dim FavCount_5
Dim FavCount_6
Dim FavCount_7
Dim arrFavourites_1
Dim arrFavourites_2
Dim arrFavourites_3
Dim arrFavourites_4
Dim arrFavourites_5
Dim arrFavourites_6
Dim arrFavourites_7

arrFavourites_1 = Array ("Cebotics.png",   "http://www.cebotics.com/phpbb2/index.php", _
			 "Meedio.png",     "http://www.meedio.com/forum/newposts.php", _
			 "MeediOS.png",    "http://www.meedios.com/forum/", _
			 "Cocoontech.png", "http://www.cocoontech.com/index.php?", _
			 "Elk_M1.png",     "http://m1dealer.elkproducts.com/index.php?&MMN_position=1:1", _
			 "Automation.png", "http://www.domoticalinks.nl/")
			   
arrFavourites_2 = Array ("BMW.png",     "http://www.bmw.nl/nl/nl/index_narrowband.html?content=http://www.bmw.nl/nl/nl/usedvehicles/overview.html", _
			 "BMW.png",     "http://www.m5board.com/vbulletin/", _
			 "Stinger.png", "http://www.stinger.com/index.php?lang=ne&sec=download", _
			 "Mobile.png",  "http://mobile.de/")

arrFavourites_3 = Array ("FlashWeather.png", "http://weather.eu.msn.com/f5/loader19.swf?mode=continent&lang=NL&continent=Europe", _
			 "KNMI.png",         "http://www.knmi.nl/", _
			 "Weather.png",      "http://www.oosterhoff.nl/pagina.nl/weer/vakantie/nl.php3", _
			 "Weather.png",      "http://www.oosterhoff.nl/pagina.nl/weer/vakantie/vakantieweer.php3", _
			 "BuienRadar.png",   "http://www.buienradar.nl/home.aspx?r=weer.startpagina.nl&jaar=-3&soort=loop1uur", _
			 "TeleWeer.png",     "http://www.teleweer.nl/freedata/radarbig.gif", _
			 "WorldSat.png",     "http://wind.met.fu-berlin.de/cgi-bin/meteosat.cgi?speed=8&count=24&intervall=30&refresh=10&playmode=Endlos")

arrFavourites_4 = Array ("Onkyo.png", "http://www.avsforum.com/avs-vb/showthread.php?t=487602")

arrFavourites_5 = Array ("Flitsservice.png", "http://flitsservice.nl/", _
			 "Snelheid.png",     "http://www.snelheidscontroles.com/", _
			 "GoogleMaps.png",   "http://www.google.nl/maps" , _
			 "ANWB.png",         "http://www.anwb.nl/published/anwbcms/content/pagina/nieuws/homepage.nl.html")

arrFavourites_6 = Array ("Ftn.png",       "http://www.ftn2day.nl/postlist.php?hoofdcat=video&subcat=divx&spots=-1", _
			 "SABnzbd.png",   "http://localhost:4715/sabnzbd/", _
			 "FirstDown.png", "http://www.firstdown.nl/", _
			 "Bios.png",      "http://www.biosagenda.nl/", _
			 "BSG.png",       "http://www.gateworld.net/galactica/s3/index.shtml")

arrFavourites_7 = Array ("Telegraaf.png",  "http://www.telegraaf.nl", _
			 "NOS.png",        "http://www.nos.nl/nos/voorpagina/", _
			 "Volkskrant.png", "http://www.volkskrant.nl/", _
			 "NU.png",         "http://www.nu.nl/", _
			 "Elsevier.png",   "http://www.elsevier.nl/")


'-------------------------------------------------------
'- Main ------------------------------------------------
'-------------------------------------------------------
SetPropertyValue "Browser.Action", "Waiting"
Sleep 100

Do
	Sleep 1
	Action = GetPropertyValue ("Browser.Action")
	If Action <> "Waiting" Then
		If Action <> "" Then
			Status = ""
			Call Handle_BrowserAction(Action)
			If Err.Number <> 0 Then
				Status = "Error: " & Err.Description
				Err.Clear
			End If
			SetPropertyValue "Browser.Status", Status
		End If
		
		'This property is set here to support a task that handles the Remote PC's Loading PopUp Panel
		SetPropertyValue "Browser.Action", "Waiting"
		Sleep 100
	End If
Loop


'-------------------------------------------------------
'-------------------------------------------------------
'-------------------------------------------------------
Sub Handle_BrowserAction(Action)
Dim Data

	Data = Split(Action, "^")

	Select Case Data(0)
		Case "OpenPanel" : Call Start_Browser()
		Case "ClosePanel": Call Stop_Browser()
		Case "Control"   : Call Control_Browser(Data(1))
		Case "Keyboard"  : Call Show_Keyboard()
		Case "Favourite" : Call Handle_Favourites(Data(1))
	End Select
End Sub


'-------------------------------------------------------
'-------------------------------------------------------
'-------------------------------------------------------
Sub Start_Browser()
Dim Data
Dim LoadingData
Dim EndFlag
Dim DotCount
	
	OpenRemotePanel("Browser Load Pop")
	Call Reset_FavCounts(0)
	EndFlag    = 0
	DotCount   = 1
	Set objIE  = CreateObject("InternetExplorer.Application")
	Data       = GetPropertyValue("Browser.Start Site")

	If Data = "" Then
		Data = "about:blank"
	End If

	With objIE
		.Navigate(Data)
		.Fullscreen  = 1
		.TheaterMode = 0
		.Toolbar     = 0
		.Menubar     = 0
		.Statusbar   = 1
		.Top         = 100
		.Left        = 0
		.Width       = 1024
		.Height      = 637 'Is 768 - 100 - Windows Taskbar height
		.Visible     = 1
		
		Do Until .ReadyState = 4 Or EndFlag = 2
			Sleep 200
			SetPropertyValue "Browser.Loading", String(DotCount, ".")
			If DotCount > 35 Then
				DotCount = 0
				EndFlag  = EndFlag + 1
			End If
			DotCount = DotCount + 1
		Loop
		
		.Document.Focus()
	End With
	
	CloseRemotePanel("Browser Load Pop")
	SetPropertyValue "Browser.Loading", ""
End Sub


'-------------------------------------------------------
'- Kill current instance + all extra opened instances --
'-------------------------------------------------------
Sub Stop_Browser()
Dim MyShell

	'Below is set to kill all iexplorers even if objIE doesn't exist anymore.
	'When objIE doesn't exist anymore, this Sub would fail and the Taskkill would not be executed
	On Error Resume Next

	Set MyShell  = CreateObject("WScript.Shell")

	objIE.Quit
	MyShell.Run "C:\Windows\System32\Taskkill.exe /F /IM iexplore.exe", 0, True

	Set MyShell  = Nothing
	Set objIE    = Nothing
End Sub


'-------------------------------------------------------
'- Control Browser options and restore focus -----------
'-------------------------------------------------------
Sub Control_Browser(Data)

	Select Case Data
		Case "Back"   : objIE.GoBack()
		Case "Forward": objIE.GoForward()
		Case "Refresh": objIE.Refresh()
		Case "Stop"   : objIE.Stop()
	End Select

	objIE.document.focus()
End Sub


'-------------------------------------------------------
'- Show Click 'n Typ virtual keyboard ------------------
'-------------------------------------------------------
Sub Show_Keyboard()
Dim MyShell

	Set MyShell = CreateObject("WScript.Shell")
	MyShell.Run "C:\Progra~1\Click-N-Type\Click-N-Type.exe", 0, False
	Set MyShell = Nothing
End Sub


'-------------------------------------------------------
'- Handle Favourite buttons ------------------------
'-------------------------------------------------------
Sub Handle_Favourites(Data)

	Select Case Data
		Case 1: FavCount_1 = Set_Favourite(1, FavCount_1, arrFavourites_1)
		Case 2: FavCount_2 = Set_Favourite(2, FavCount_2, arrFavourites_2)
		Case 3: FavCount_3 = Set_Favourite(3, FavCount_3, arrFavourites_3)
		Case 4: FavCount_4 = Set_Favourite(4, FavCount_4, arrFavourites_4)
		Case 5: FavCount_5 = Set_Favourite(5, FavCount_5, arrFavourites_5)
		Case 6: FavCount_6 = Set_Favourite(6, FavCount_6, arrFavourites_6)
		Case 7: FavCount_7 = Set_Favourite(7, FavCount_7, arrFavourites_7)
	End Select
End Sub


'-------------------------------------------------------
'- Set requested Favourite and return the current count-
' - FCount 0, 2, 4 etc = Image - FCount 1, 3, 5 = URL --
'-------------------------------------------------------
Function Set_Favourite(FavImageNr, FavCount, arrFavourites)
Dim URL
Dim FCount

	'Store the FavCount in a temp value to save the value of FavCount_x since FavCount is a pointer to FavCount_x 
	FCount = FavCount
	Call Reset_FavCounts(FavImageNr)
	FCount = FCount + 2
	
	If FCount > UBound(arrFavourites) Then
		FCount = 1
	End If

	URL = arrFavourites(FCount)

	If URL = "" Then
		FCount = 1
		URL    = arrFavourites(FCount)
	End If

	If URL = "" Then
		URL = "about:blank"
	End If

	SetPropertyValue "Browser.Icon " & FavImageNr, GetPropertyValue("Browser.Picture Path") & arrFavourites(FCount - 1)
	objIE.Navigate(URL)
	objIE.Document.Focus()
	Set_Favourite = FCount
End Function


'-------------------------------------------------------
'- Reset Favourite Counts ------------------------------
'-------------------------------------------------------
Sub Reset_FavCounts(FavImageNr)
Dim nit
Dim Icon(10)

	Icon(1) = arrFavourites_1(0)
	Icon(2) = arrFavourites_2(0)	
	Icon(3) = arrFavourites_3(0)	
	Icon(4) = arrFavourites_4(0)	
	Icon(5) = arrFavourites_5(0)	
	Icon(6) = arrFavourites_6(0)	
	Icon(7) = arrFavourites_7(0)	

	For nit = 1 To 7
		If nit <> FavImageNr Then
			SetPropertyValue "Browser.Icon " & nit, GetPropertyValue("Browser.Picture Path") & Icon(nit)
		End If
	Next

	FavCount_1 = -1
	FavCount_2 = -1
	FavCount_3 = -1
	FavCount_4 = -1
	FavCount_5 = -1
	FavCount_6 = -1
	FavCount_7 = -1
End Sub

HouseBot

Web browser from vbscript

Web browser from vbscript

The script