' DesktopWeather by Judge (samurize@jools.net)
' v 0.1 - Initial Version
' v 0.2 - Handles the user preferences being set to metric
'		- Handles international (non-US) hourly forecasts
' v 0.3 - Fixed the hourlyURL fix (hopefully)!
' v 0.4 - Added more weather symbols and fixed to match latest HTML from weather.com

const CITY               = "Shenzhen, China"		' Set this to your city, dont forget the format "<zip code>" for U.S.A. or "city, country" elsewhere.
const USE_CELCIUS        = false		' If you want the degrees in celcius or farenheit.
const MPH                = true			' If you want the wind speed in miles or kilometer per hour.
const RESTART            = true		' If you want to restart the client after a cache file update.
const INSTANCE_NAME      = "default"	' Name of the samurize instance to restart
const SAMURIZE_DIRECTORY = "D:\Program Files\Samurize" 'change if different than yours


' CODE AFTER THIS, DO NOT CHANGE
dim icons, tempSymbol, dailyFile, hourlyFile, check, checkright, dailyURL, hasDegF

dailyFile  = SAMURIZE_DIRECTORY & "\Scripts\weather.daily.html"
hourlyFile = SAMURIZE_DIRECTORY & "\Scripts\weather.hourly.html"
dailyURL   = "http://beta.weather.com/search/search?where=" & CITY

'              0,  1,  2,  3,  4,  5,  6,  7,  8,  9, 10, 11, 12, 13, 14, 15, 16, 17, 18 19,20,21,22,23, 24,25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38,39, 40, 41, 42, 43
icons = array("","B","B","D","D","A","B","A","B","B","B","B","B","P","P","A","P","D","B","","","","","","#","","S","S","R","F","R","M","Q","F","Q","D","I","E","E","","A","A","A","R")

check = boundedString("<TITLE>", "</TITLE>", dailyFile)
If check = "weather.com - Search" Then checkright = "NOK" Else checkright = "OK"

If USE_CELCIUS Then
	tempSymbol = "°C"
else
	tempSymbol = "°F"
End If

Function getTempSymbol
	getTempSymbol = tempSymbol
End Function

Function getCity
	If checkright = "OK" Then
	 getCity = boundedString("Forecast for ","</B>", dailyFile)
	Else
	 getCity = "City not found"
	End If
End Function

Function getTime
	If checkright = "OK" Then
		getTime = boundedString("&nbsp;Last Updated ", ".", dailyFile)
		dateparts = split(getTime, ", ")
		timeparts = split(dateparts(3))
		getTime = timeparts(1) & " " & timeparts(2)
	Else
		getTime = "N/A"
	End If
End Function

Function getDate
	If checkright = "OK" Then
		getDate = boundedString("&nbsp;Last Updated ", ".", dailyFile)
		dateparts = split(getDate, ", ")
		getDate = dateparts(0) & ", " & dateparts(1) & ", " & dateparts(2)
	Else
		getDate = "N/A"
	End If
End Function

' Use this function if you are using the weather font
Function getSymbol
	If checkright = "OK" Then
	 icon = boundedString("SRC=http://image.weather.com/web/common/please_use_our_XML_feed_instead_of_scraping_this_page/52/", ".gif", dailyFile)
	 getSymbol = icons(icon)
	Else
	 getSymbol = A
	End If
End Function

Function convertTemperature(val)
	convertTemperature = val
	If val <> "N/A" Then
		If USE_CELCIUS Then
			If hasDegF > 0 Then
				convertTemperature = round((5/9)*(val -32))
			End if
		Else
			If hasDegF = 0 Then
				convertTemperature = round(val * 9 / 5 + 32)
			End If
		End If
	End If
End Function

Function getTemperature
	getTemperature = "N/A"
	If checkright = "OK" Then
	 getTemperature = convertTemperature(boundedString("<B CLASS=obsTempTextA>", "&deg;", dailyFile))
	End If
End Function

Function getFeelsLike
	getFeelsLike = "N/A"
	If checkright = "OK" Then
	 getFeelsLike = convertTemperature(boundedString("<B CLASS=obsTextA>Feels Like<BR>", "&deg;", dailyFile))
	End If
End Function

Function getCondition
	If checkright = "OK" Then
	 getCondition = boundedString("CLASS=obsInfo2><B CLASS=obsTextA>", "</B></TD>", dailyFile)
	Else
	 getCondition = "N/A"
	End If
End Function

Function getPrecipChance
	If checkright = "OK" Then
	 getPrecipChance = boundedString3(">", " %", 1, boundedString2("<TD CLASS=inDentWhite10DayA5><DIV ALIGN=CENTER", "</DIV>", 2, dailyFile))
	Else
	 getPrecipChance = "N/A"
	End If
End Function

Function getWindDirection
	Dim dMap
	Set dMap = CreateObject("Scripting.Dictionary")
	dMap.add "North", 0
	dMap.add "North Northeast", 1
	dMap.add "Northeast", 2
	dMap.add "East Northeast", 3
	dMap.add "East", 4
	dMap.add "East Southeast", 5
	dMap.add "Southeast", 6
	dMap.add "South Southeast", 7
	dMap.add "South", 8
	dMap.add "South Southwest", 9
	dMap.add "Southwest", 10
	dMap.add "West Southwest", 11
	dMap.add "West", 12
	dMap.add "West Northwest", 13
	dMap.add "Northwest", 14
	dMap.add "North Northwest", 15
	
	If checkright = "OK" Then
	  getWindDirection = boundedString2("<TD ALIGN=LEFT VALIGN=TOP CLASS=obsInfo2>", "</TD>", 6, dailyFile)
	  spos = instrrev(getWindDirection, "From the ")+9
	  chrs = instrrev(getWindDirection, " at") - spos
	  direction = Mid(getWindDirection, spos, chrs)
	  getWindDirection = dMap.item(direction)
	Else
	 Win = "N/A"
	End If
End Function

Function convertSpeed(val)
	convertSpeed = val
	If val <> "N/A" Then
		If NOT mph Then
			If hasDegF > 0 Then
				convertSpeed = round(val * 1.609344)
			End if
		Else
			If hasDegF = 0 Then
				convertSpeed = round(val / 1.609344)
			End If
		End If
	End If
End Function

Function getWindSpeed
	If checkright = "OK" Then
	  getWindSpeed = boundedString2("<TD ALIGN=LEFT VALIGN=TOP CLASS=obsInfo2>", "</TD>", 6, dailyFile)
	  spos = instrrev(getWindSpeed, "at ")+3
	  chrs = instrrev(getWindSpeed, " ") - spos
	  getWindSpeed = Mid(getWindSpeed, spos, chrs)
	  getWindSpeed = convertSpeed(getWindSpeed)
	Else
	 Win = "N/A"
	End If
End Function

Function getWind
	If checkright = "OK" Then
	getWind = boundedString2("<TD ALIGN=LEFT VALIGN=TOP CLASS=obsInfo2>", "</TD>", 6, dailyFile)
	spos = instrrev(getWind, "at ")+3
	chrs = instrrev(getWind, " ") - spos
	speed = Mid(getWind, spos, chrs)
	nspeed = convertSpeed(speed)
    getWind = replace(getWind, speed, nspeed)
	If mph = false then
	  getWind = replace(getWind, "mph", "km/h")
	Else
	  getWind = replace(getWind, "km/h", "mph")
	End If
	Else
	 Win = "N/A"
	End If
End Function

' Return humidity as a percentage
Function getHumidity
	If checkright = "OK" Then
	 getHumidity = boundedString3(">", "%", 1, boundedString2("<TD ALIGN=LEFT VALIGN=TOP CLASS=obsInfo2", "</TD>", 3, dailyFile))
	Else
	 getHumidity = "N/A"
	End If
End Function

Function getVisibility
	getVisibility = "N/A"
	If checkright = "OK" Then 
	 getVisibility = boundedString2("<TD ALIGN=LEFT VALIGN=TOP CLASS=obsInfo2>", "</TD>", 4, dailyFile) 
	 if InStr(getVisibility, "Unlimited") = 0 then
	   chrs = instrrev(getVisibility, " ")-1 
	   vis = Mid(getVisibility, 1, chrs) 
	   nvis = convertSpeed(vis)
	   getVisibility = replace(getVisibility, vis, nvis)
	 End If 
	 if mph Then
	 	getVisibility = replace(getVisibility, "kilometers", "miles") 
	 Else
	    getVisibility = replace(getVisibility, "miles", "kilometers") 
	 End If
	End If 
End Function 

Function getPressure
	If checkright = "OK" Then
	 getPressure = boundedString2("<TD ALIGN=LEFT VALIGN=TOP CLASS=obsInfo2>", "</TD>", 5, dailyFile)
	Else
	 getPressure = "N/A"
	End If
End Function

Function getDewPoint
	If checkright = "OK" Then
	 getDewPoint = convertTemperature(boundedString2("<TD ALIGN=LEFT VALIGN=TOP CLASS=obsInfo2>", "&deg;", 2, dailyFile))
	Else
	 getDewPoint = "N/A"
	End If
End Function

Function getUV
	If checkright = "OK" Then
	 getUV = boundedString("<TD ALIGN=LEFT VALIGN=TOP CLASS=obsInfo2>", "</TD>", dailyFile)
	Else
	 getUV = "N/A"
	End If
End Function

' Hour number for forecasts all start at zero
Function getHourlyTemp(hourNum)
	getHourlyTemp = "N/A"
	If checkright = "OK" Then
	 ' isnert, sic!
	 getHourlyTemp = convertTemperature(boundedString2("<B><!-- isnert temp -->", "&deg;", hourNum+1, hourlyFile))
	End If
End Function

Function getHourlyHour(hourNum)
	getHourlyHour = "N/A"
	If checkright = "OK" Then
	 getHourlyHour = boundedString2("<!-- insert hour --> <B>", "</B>", hourNum+1, hourlyFile)
	End If
End Function

' Day numbers for forecasts all start at zero
Function getDayFC(dayNum)
	If checkRight = "OK" Then
		' <TD CLASS=inDentWhite10DayA11><A HREF=/weather/local/01450>Today</A><BR> Apr 29</TD>
		getDayFC = boundedString2("<TD CLASS=inDent", "</TD>", 1+(5*dayNum), dailyFile)
		getDayFC = boundedString3(">", "<BR>", 1, getDayFC)
		getDayFC = boundedString3(">","</A>", 1, getDayFC)
	Else
		getDayFC = "N/A"
	End If
End Function

Function getDateFC(dayNum)
	If checkRight = "OK" Then
		getDateFC = Trim(boundedString3("</A><BR>", "</", 1, boundedString2("/detail/","td>",dayNum+1, dailyFile)))
	Else
		getDateFC = "N/A"
	End If
End Function

Function getConditionFC(dayNum)
	If checkright = "OK" Then
	 getConditionFC = boundedString3(">", "<", 1, boundedString2("<TD CLASS=inDent", "/TD>", 3 + (5*dayNum), dailyFile))
	Else
	 getConditionFC = "N/A"
	End If
End Function

Function getSymbolFC(dayNum)
	If checkright = "OK" Then
	 icon = boundedString2("<IMG SRC=http://image.weather.com/web/common/please_use_our_XML_feed_instead_of_scraping_this_page/31/", ".gif", dayNum+1, dailyFile)
	 getSymbolFC = icons(icon)
	Else
	 getSymbolFC = A
	End If
End Function

Function getHighFC(dayNum)
	getHighFC = "N/A"
	If checkright = "OK" Then
	 getHighFC = boundedString2("5><DIV ALIGN=CENTER><B>", "</B>", dayNum + 1, dailyFile)
	 slashPos = InStr(getHighFC, "N/A")
	 If slashPos = 1 Then
	 	getHighFC = "N/A"
	 Else
	 	slashPos = InStr(getHighFC, "/")
	 	If slashPos > 0 Then
	 	 getHighFC = Mid(getHighFC, 1, slashPos-1)
	 	Else
	 	 getHighFC = "N/A"
	 	End If
	 End If

	 If getHighFC <> "N/A" Then
	  ' Strip off trailing &deg;
	  getHighFC = convertTemperature(Mid(getHighFC, 1, InStr(getHighFC, "&deg;")-1))
	 End If
	End If
End Function

Function getLowFC(dayNum)
	getLowFC = ""
	If checkright = "OK" Then
	 getLowFC = boundedString2("5><DIV ALIGN=CENTER><B>", "</B>", dayNum + 1, dailyFile)
	 slashPos = InStr(getLowFC, "N/A")
	 
	 If slashPos = 1 Then
	 	' High Temperature = N/A
	 	slashPos = InStr(4, getLowFC, "/")
   	    getLowFC = Mid(getLowFC, slashPos+1)
	 Else
	 	slashPos = InStr(getLowFC, "/")
	 	If slashPos > 0 Then
    	 getLowFC = Mid(getLowFC, slashPos+1)
	 	End If
	 End If

 	 If getLowFC <> "N/A" Then
  		getLowFC = convertTemperature(Mid(getLowFC, 1, InStr(getLowFC, "&deg;")-1))
  	 End If
  	End If
End Function

Function getHighLowFC(dayNum)
	getHighLowFC = getHighFC(dayNum)
	if getHighLowFC = "N/A" Then
		getHighLowFC = getLowFC(dayNum)
	Else
		getHighLowFC = getHighLowFC & "/" & getLowFC(dayNum)
	End If
End Function

Function getPrecipChanceFC(dayNum)
	If checkright = "OK" Then
	 getPrecipChanceFC = boundedString3("><DIV ALIGN=CENTER>", " %</DIV>", 1, boundedString2("<TD CLASS=inDent", "</TD>", 5 + (5*dayNum), dailyFile))
	Else
	 PrecipChance = "N/A"
	End If
End Function

Function decodeImage (iconNum)
Dim res

res = iconNum
  
  Select Case iconNum
	Case	1	res="WindyRain.png"
	Case	3	res="WindyRain.png"
	Case	4	res="Thunder.png"
	Case	5	res="Sleet.png"
	Case	6	res="LightRain.png"
	Case	7	res="Sleet.png"
	Case	8	res="Sleet.png"
	Case	9	res="LightRain.png"
	Case	10	res="Sleet.png"
	Case	11	res="LightRain.png"
	Case	12	res="HeavyRain.png"
	Case	13	res="LightSnow.png"
	Case	14	res="Snow.png"
	Case	15	res="Snow.png"
	Case	16	res="Snow.png"
	Case	17	res="Thunder.png"
	Case	18	res="HeavyRain.png"
	Case	19	res="Dust.png"
	Case	20	res="Fog.png"
	Case	21	res="Haze.png"
	Case	22	res="Smoke.png"
	Case	23	res="Wind.png"
	Case	24	res="Wind.png"
	Case	25	res="SmallerMoon.png"
	Case	26	res="Cloudy.png"
	Case	27	res="MostlyCloudyNight.png"
	Case	28	res="MostlyCloudy.png"
	Case	29	res="PartlyCloudyNight.png"
	Case	30	res="PartlyCloudy.png"
	Case	31	res="smallermoon.png"
	Case	32	res="SmallerSun.png"
	Case	33	res="PartlyCloudyNight.png"
	Case	34	res="PartlyCloudy.png"
	Case	35	res="Thunder.png"
	Case	36	res="SmallerSun.png"
	Case	37	res="IsolatedThunder.png"
	Case	38	res="ScatteredThunder.png"
	Case	39	res="ScatteredShowers.png"
	Case	40	res="HeavyRain.png"
	Case	41	res="Snow.png"
	Case	42	res="Snow.png"
	Case	43	res="Windy.png"
	Case	44	res="PartlyCloudy.png"
	Case	45	res="ScatteredShowersNight.png"
	Case	46	res="ScatteredSnowNight.png"
	Case	47	res="ScatteredThunderNight.png"
  End Select	

  decodeImage= res
End Function

Function copyImage(imageName, suffix)
  Dim fso
  Set fso= CreateObject("Scripting.FileSystemObject")
  
  fso.CopyFile SAMURIZE_DIRECTORY & "\Skins\DesktopWeather\" & imageName, SAMURIZE_DIRECTORY & "\Skins\DesktopWeather\tmpImage" & suffix & ".png", True

  Set fso = Nothing
End Function

Function BinToText(varBinData, intDataSizeInBytes) 
         On Error Resume Next  
              
         Const adFldLong = &H00000080 
         Const adVarChar = 200 
         Set objRS = CreateObject("ADODB.Recordset") 
  
         objRS.Fields.Append "txt", adVarChar, intDataSizeInBytes, adFldLong 
         objRS.Open 
  
         objRS.AddNew 
         objRS.Fields("txt").AppendChunk varBinData 
         BinToText = objRS("txt").Value 
  
         objRS.Close 
         Set objRS = Nothing 
End Function

Function getHourlyURL
	getHourlyURL = boundedString("<TD CLASS=inDentWhite10DayA11><A HREF=", ">", dailyFile)
End Function

Function getCacheFiles(mins)
	On Error Resume Next
	Dim oldFile1, oldFile2, hourlyURL
	
	oldFile1 = getCacheFile(mins, dailyFile, dailyURL)
	hourlyURL = boundedString("<TD CLASS=inDentWhite10DayA11><A HREF=", ">", dailyFile)
	If InStr(1, hourlyURL, "http:", 1) = 0 Then
		hourlyURL = "http://beta.weather.com" & hourlyURL
	End If
	hourlyURL = hourlyURL & "?dayNum=0"
	If oldFile1 Then
		imageName = decodeImage(boundedString("SRC=http://image.weather.com/web/common/please_use_our_XML_feed_instead_of_scraping_this_page/52/", ".gif", dailyFile))
		res = copyImage(imageName, "Main")
		
		For i=0 To 9
			iName = decodeImage(boundedString2("<IMG SRC=http://image.weather.com/web/common/please_use_our_XML_feed_instead_of_scraping_this_page/31/", ".gif", i+1, dailyFile))
			copyImage iName, i
		Next
	End If

	oldFile2 = getCacheFile(mins, hourlyFile, hourlyURL)
	
	If oldFile1 OR oldFile2 Then
		restartClient
	End If
	
'	getCacheFiles = oldFile1 OR oldFile2
End Function

Function getCacheFile(mins, filename, fileURL)
	Dim oldFile
	
	set fs=CreateObject("Scripting.FileSystemObject")
 
	If (Not fs.FileExists(filename)) Then
	  oldFile = True
	Else
	  Set cacheFile= fs.GetFile(filename)
	  
	  oldFile = False
	
	   If (CInt (DateDiff("n", cacheFile.DateLastModified, Now())) >= CInt(mins)) Then
	    oldFile= True
	  End If  
	End If
	
	If oldFile Then
		Randomize
		GetURL = fileURL & "&random=" & Rnd
		
		Dim Http
		
		Set Http = CreateObject("Microsoft.XMLhttp")
		Http.Open "GET",GetURL,False
		Http.Send
		HtmlResult = BinToText(Http.ResponseText, len(Http.ResponseText))
		HtmlResult = ExtractTicker(HtmlResult)

		Set Http = Nothing
		
		set f=fs.CreateTextFile(filename)
		f.write(htmlresult)
		f.close
		set f=nothing
		set fs=nothing
	End If
	
	getCacheFile=oldFile
End Function

Private Function ExtractTicker(HtmlResult)

etstart = Quote & "svrWxAlert\" & Quote
etend = "<!-- end svr wx alert -->" 

searchstart = InStr(HtmlResult, etstart) - 91
searchend = InStr(HtmlResult, etend) + Len(etend)

If searchstart > 0 AND searchend > 0 Then
 ExtractTicker = Replace(HtmlResult,Mid(HtmlResult, searchstart, searchend - searchstart)," ")
Else
 ExtractTicker = HtmlResult
End If
etstart = "<!-- <B CLASS=obsTempTextA>N/A&deg;F"
etend = "</TR> -->"
searchstart = InStr(ExtractTicker, etstart) 
searchend = InStr(ExtractTicker, etend) + Len(etend)

If searchstart > 0 AND searchend > 0 Then
 ExtractTicker = Replace(ExtractTicker,Mid(ExtractTicker, searchstart, searchend - searchstart)," ")
End If
etstart = "<!-- normal.css -->"
etend = "</TABLE>"
searchstart = InStr(ExtractTicker, etstart) 
searchend = InStr(ExtractTicker, etend) + Len(etend)

If searchstart > 0 AND searchend > 0 Then
 ExtractTicker = Replace(ExtractTicker,Mid(ExtractTicker, searchstart, searchend - searchstart)," ")
End If

End Function

Function boundedString(LeftBound, RightBound, fileName)
	boundedString = boundedString2(LeftBound, RightBound, 1, fileName)
End Function

Function boundedString2(LeftBound, RightBound, count, fileName)
	Dim HtmlResult
	
	Set file_obj = CreateObject ("Scripting.FileSystemObject")
	
	If (file_obj.FileExists(fileName)) Then
	 Set file_path = file_obj.GetFile(fileName) ' Creates the connection to the file
	 set file = file_path.OpenAsTextStream (1, -2) ' Opens the file for reading
	
	 HtmlResult = file.readall
	 hasDegF = InStr(HtmlResult, "&deg;F")
	 
	 File.Close ' Closes the file
	 Set file_path = nothing ' Resets variable
	 Set file_obj = nothing ' Resets variable
	
	 boundedString2 = boundedString3(LeftBound, RightBound, count, HtmlResult)
	Else
	 boundedString2 = "N/A"
	End If
End Function

Function boundedString3(LeftBound, RightBound, count, HtmlResult)
	 HtmlStart = InStr(1, HtmlResult, LeftBound, 1) + Len(LeftBound)
	 HtmlEnd = InStr(HtmlStart, HtmlResult, RightBound, 1)
	
	 For counter = 2 To count
	  HtmlStart = InStr(HtmlEnd + Len(RightBound), HtmlResult, LeftBound, 1) + Len(LeftBound) 
	  HtmlEnd = InStr(HtmlStart, HtmlResult, RightBound, 1)
	 Next
	
	 If HtmlStart > 0 AND HtmlEnd > 0 Then
	  boundedString3 = Replace(Mid(HtmlResult, HtmlStart, HtmlEnd - HtmlStart ), "&nbsp;", " ")
	 Else
	  boundedString3 = "N/A"
	 End If
End Function

Function restartClient
	  Dim objWMIService, colProcessList, objProcess
	  
	  If RESTART Then
		  Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
		  Set colProcessList = objWMIService.ExecQuery ("select * from Win32_Process where CommandLine LIKE '%Client.exe%" & INSTANCE_NAME & "%'")
	
		  ' Refresh this instance of samurize	
		  startClient
	
		  restartClient="terminating process"
	
		  ' Now kill our caller
		  For Each objProcess in colProcessList
		    killProcess(objProcess)
		  Next
		End If
End Function

function startClient
'  Dim objProcess, errReturn, intProcessID 
'  Set objProcess = GetObject("winmgmts:root\cimv2:Win32_Process")
'  errReturn = objProcess.Create(SAMURIZE_DIRECTORY & "\Client.exe " & INSTANCE_NAME, null, null, intProcessID)

'  startClient = errReturn
  Dim WshShell
  Set WshShell = createobject("wscript.shell")
  Dim oExec
  Set oExec = WshShell.Exec(SAMURIZE_DIRECTORY & "\Client.exe " & INSTANCE_NAME)
End Function

Function killProcess(objProcess)
		objProcess.terminate(0)
End Function