Weather Scraper: 5 Day Forecast

General HouseBot discussion. Any issues that don't fit into any of the other topics belong here.
Osler
HouseBot Guru
Posts: 742
Joined: Fri Feb 03, 2006 11:18 pm

Post by Osler »

You can just comment that out. On mine, for some reason the page wouldn't download to the variable and vbscript would get all bent out of shape and throw an error when I tried to manipulate an empty string. I don't know a more elegant way to exit the script....anyone....any ideas....I am not a vbscript guru by any stretch.

Osler
Osler
HouseBot Guru
Posts: 742
Joined: Fri Feb 03, 2006 11:18 pm

Post by Osler »

See if this doesn't fix the problem. I noticed when I looked at it again, it had broken. I have added some code to look specifically for temp, humidity, etc and place it in the correct variable. I also parsed out only the metric readings for you. Visibility has been removed....doesn't appear to always be provided.

Code: Select all

'Step 1: Create a Script Device called "CurrentWeather"
'Step 2: Under "Settings", "Property Manager" add the following properties: CWLocation, CWTime, CWTemperature, CWHumidity, CWWindSpeed, CWBarometer, CWVisibility, and CWDewPoint
'====Property Name and Description should be the same


'This is a script to scrape current weather information from the NOAA website for Vasteras, Sweden

Dim sCurrent, oXMLHTTP, sURLCurrent, Parse1, Parse2, WeatherArray(5)
Dim sLocation, sTime

sURLCurrent = "http://weather.noaa.gov/weather/current/ESOW.html"

'Create the xmlhttp object so you can use it to gather data from the webpages
Set oXMLHTTP = CreateObject("microsoft.xmlhttp")

'Get the current data from NOAA
oXMLHTTP.Open "GET", sURLCurrent, True
oXMLHTTP.Send

'Do some error trapping to ensure the server is up and all data was sent
If oXMLHTTP.readyState = 4 Then
     If oXMLHTTP.status = 200 Then
          'Save the html from the site to the appropriate variable
          sCurrent = oXMLHTTP.responseText
     Else
          alert("There was a problem retrieving the current weather data.")
     End If
End If

'Destroy the object you created
Set oXMLHTTP = Nothing

'If nothing was downloaded from the site then exit
If sCurrent = "" Then WScript.quit

'Now parse the data out of the file

'Search for the location
Parse1 = InStr(sCurrent, "Current Weather Conditions:<BR>")
Parse1 = Parse1 + 31
Parse2 = InStr(Parse1, sCurrent, "</B>")
sLocation = Trim(Mid(sCurrent, Parse1, Parse2 - Parse1))
SetPropertyValue "CurrentWeather.CWLocation", sLocation

'Search for the update time
Parse1 = InStr(Parse2, sCurrent, "<OPTION SELECTED>")
Parse1 = Parse1 + 17
Parse2 = InStr(Parse1, sCurrent, "<OPTION>")
sTime = Trim(Mid(sCurrent, Parse1, Parse2 - Parse1))
SetPropertyValue "CurrentWeather.CWTime", sTime

For I = 0 to 4

Select Case I
	Case 0
		SearchParameter = "Temperature"
	Case 1
		SearchParameter = "Dew Point"
	Case 2
		SearchParameter = "Relative Humidity"
	Case 3
		SearchParameter = "Pressure"
	Case 4
		SearchParameter = "Wind </FONT>"
End Select

Parse2 = InStr(1, sCurrent, SearchParameter)
Parse1 = InStr(Parse2, sCurrent, "<TD><FONT FACE=" & Chr(34) & "Arial,Helvetica" & Chr(34) & ">")
Parse1 = Parse1 + 33
Parse2 = InStr(Parse1, sCurrent, "</FONT>")
WeatherArray(I) = Replace(Trim(Mid(sCurrent, Parse1, Parse2 - Parse1)), Chr(10), "")

Select Case I
	Case 0
		Parse1 = InStr(WeatherArray(I), "(")
		Parse1 = Parse1 + 1
		Parse2 = InStr(WeatherArray(I), ")")
		WeatherArray(I) = Mid(WeatherArray(I), Parse1, Parse2 - Parse1)
	Case 1
		Parse1 = InStr(WeatherArray(I), "(")
		Parse1 = Parse1 + 1
		Parse2 = InStr(WeatherArray(I), ")")
		WeatherArray(I) = Mid(WeatherArray(I), Parse1, Parse2 - Parse1)
	Case 3
		Parse1 = InStr(WeatherArray(I), "(")
		Parse1 = Parse1 + 1
		Parse2 = InStr(WeatherArray(I), ")")
		WeatherArray(I) = Mid(WeatherArray(I), Parse1, Parse2 - Parse1)
	Case 4
		Dim HoldingVariable
		Parse1 = InStr(WeatherArray(I), "at")
		HoldingVariable = Mid(WeatherArray(I), 1, Parse1 - 1)
		Parse1 = InStr(WeatherArray(I), "(")
		Parse1 = Parse1 + 1
		Parse2 = InStr(WeatherArray(I), ")")
		WeatherArray(I) = HoldingVariable & "at " & Mid(WeatherArray(I), Parse1, Parse2 - Parse1)
End Select

Next

 
SetPropertyValue "CurrentWeather.CWTemperature", WeatherArray(0)

SetPropertyValue "CurrentWeather.CWHumidity", WeatherArray(2)

SetPropertyValue "CurrentWeather.CWWindSpeed", WeatherArray(4)

SetPropertyValue "CurrentWeather.CWBarometer", WeatherArray(3)

SetPropertyValue "CurrentWeather.CWDewPoint", WeatherArray(1)
Osler
wallebalboa
Senior Member
Posts: 111
Joined: Wed Aug 11, 2004 6:52 pm
Location: Sweden

Post by wallebalboa »

Thanx.
if i comment the "If sCurrent = "" Then WScript.quit " out i get errors with the mid command... probably for empty string...
is it possible to jump to the end of script instead of exit? :oops:

regs AW
Osler
HouseBot Guru
Posts: 742
Joined: Fri Feb 03, 2006 11:18 pm

Post by Osler »

Yeah, that is my problem as well. Try keeping the WScript.Quit in place. I didn't have the s capitalized and was using .exit instead of .quit. See if it works without commenting it out. Otherwise I may need to add an if/then loop in the server code.

Osler
Richard Naninck
HouseBot Guru Extraordinaire
Posts: 1121
Joined: Tue Sep 28, 2004 7:49 am
Location: The Netherlands

Post by Richard Naninck »

I thought HouseBot could not handle the WScript object. Why not create a Sub, put everything in the Sub, Call the Sub in the beginning and use the vbscript command 'Exit Sub' when you need to end the script.
Osler
HouseBot Guru
Posts: 742
Joined: Fri Feb 03, 2006 11:18 pm

Post by Osler »

hehe....didn't know that about WScript and HB.

That is a prime idea with the subroutine. Much appreciated.

Osler
Osler
HouseBot Guru
Posts: 742
Joined: Fri Feb 03, 2006 11:18 pm

Post by Osler »

Updated after Richards recommendation.

Code: Select all

'Step 1: Create a Script Device called "CurrentWeather" 
'Step 2: Under "Settings", "Property Manager" add the following properties: CWLocation, CWTime, CWTemperature, CWHumidity, CWWindSpeed, CWBarometer, CWVisibility, and CWDewPoint 
'====Property Name and Description should be the same 


'This is a script to scrape current weather information from the NOAA website for Vasteras, Sweden 

Dim sCurrent, oXMLHTTP, sURLCurrent, Parse1, Parse2, WeatherArray(5) 
Dim sLocation, sTime 

sURLCurrent = "http://weather.noaa.gov/weather/current/ESOW.html"

Call(GetWeather)

Private Sub GetWeather() 

	'Create the xmlhttp object so you can use it to gather data from the webpages 
	Set oXMLHTTP = CreateObject("microsoft.xmlhttp") 

	'Get the current data from NOAA 
	oXMLHTTP.Open "GET", sURLCurrent, True 
	oXMLHTTP.Send 

	'Do some error trapping to ensure the server is up and all data was sent 
	If oXMLHTTP.readyState = 4 Then 
     		If oXMLHTTP.status = 200 Then 
          		'Save the html from the site to the appropriate variable 
          		sCurrent = oXMLHTTP.responseText 
     		Else 
          		alert("There was a problem retrieving the current weather data.") 
     		End If 
	End If 

	'Destroy the object you created 
	Set oXMLHTTP = Nothing 

	'If nothing was downloaded from the site then exit 
	If sCurrent = "" Then Exit Sub 

	'Now parse the data out of the file 

	'Search for the location 
	Parse1 = InStr(sCurrent, "Current Weather Conditions:<BR>") 
	Parse1 = Parse1 + 31 
	Parse2 = InStr(Parse1, sCurrent, "</B>") 
	sLocation = Trim(Mid(sCurrent, Parse1, Parse2 - Parse1)) 
	SetPropertyValue "CurrentWeather.CWLocation", sLocation 

	'Search for the update time 
	Parse1 = InStr(Parse2, sCurrent, "<OPTION SELECTED>") 
	Parse1 = Parse1 + 17 
	Parse2 = InStr(Parse1, sCurrent, "<OPTION>") 
	sTime = Trim(Mid(sCurrent, Parse1, Parse2 - Parse1)) 
	SetPropertyValue "CurrentWeather.CWTime", sTime 

	For I = 0 to 4 

	Select Case I 
   		Case 0 
      			SearchParameter = "Temperature" 
   		Case 1 
      			SearchParameter = "Dew Point" 
   		Case 2 
      			SearchParameter = "Relative Humidity" 
   		Case 3 
      			SearchParameter = "Pressure" 
   		Case 4 
      			SearchParameter = "Wind </FONT>" 
	End Select 

	Parse2 = InStr(1, sCurrent, SearchParameter) 
	Parse1 = InStr(Parse2, sCurrent, "<TD><FONT FACE=" & Chr(34) & "Arial,Helvetica" & Chr(34) & ">") 
	Parse1 = Parse1 + 33 
	Parse2 = InStr(Parse1, sCurrent, "</FONT>") 
	WeatherArray(I) = Replace(Trim(Mid(sCurrent, Parse1, Parse2 - Parse1)), Chr(10), "") 

	Select Case I 
   		Case 0 
      			Parse1 = InStr(WeatherArray(I), "(") 
      			Parse1 = Parse1 + 1 
      			Parse2 = InStr(WeatherArray(I), ")") 
      			WeatherArray(I) = Mid(WeatherArray(I), Parse1, Parse2 - Parse1) 
   		Case 1 
      			Parse1 = InStr(WeatherArray(I), "(") 
      			Parse1 = Parse1 + 1 
      			Parse2 = InStr(WeatherArray(I), ")") 
      			WeatherArray(I) = Mid(WeatherArray(I), Parse1, Parse2 - Parse1) 
   		Case 3 
      			Parse1 = InStr(WeatherArray(I), "(") 
      			Parse1 = Parse1 + 1 
      			Parse2 = InStr(WeatherArray(I), ")") 
      			WeatherArray(I) = Mid(WeatherArray(I), Parse1, Parse2 - Parse1) 
   		Case 4 
      			Dim HoldingVariable 
      			Parse1 = InStr(WeatherArray(I), "at") 
      			HoldingVariable = Mid(WeatherArray(I), 1, Parse1 - 1) 
      			Parse1 = InStr(WeatherArray(I), "(") 
      			Parse1 = Parse1 + 1 
      			Parse2 = InStr(WeatherArray(I), ")") 
      			WeatherArray(I) = HoldingVariable & "at " & Mid(WeatherArray(I), Parse1, Parse2 - Parse1) 
	End Select 

	Next 

  
	SetPropertyValue "CurrentWeather.CWTemperature", WeatherArray(0) 

	SetPropertyValue "CurrentWeather.CWHumidity", WeatherArray(2) 

	SetPropertyValue "CurrentWeather.CWWindSpeed", WeatherArray(4) 

	SetPropertyValue "CurrentWeather.CWBarometer", WeatherArray(3) 

	SetPropertyValue "CurrentWeather.CWDewPoint", WeatherArray(1) 

End Sub
Osler
Post Reply