Some Scripts

[allanstevens]

I though I would post a few of my scripts, I hope they will be of interest to some of you.

I was going to post this in the vbscript section, but it's locked and can't workout how to post to the main scripts section on the website? anyway...

UK Train Departures

Works with the following uk train operators (I have it working with c2c)

c2c, Chiltern Railways, East Coast, First Capital Connect, First Great Western, First ScotRail, Greater Anglia, London Midland, London Overground, South West Trains, Southeastern, Southern, Transpennine Express

The URL in the script is constructed as follows
http://pda.jcheck.com/[TRAIN OPERATOR]/route?from=[STATION]&type=departures

You will require a device in housebot with the follow names: Train Departures.Train 1, Train Departures.Train 2, Train Departures.Train 3, Train Departures.Train 4.

Code: Select all

On Error Resume Next

call SetPropertyValue("Train Departures.Train 1","Updating...")
call SetPropertyValue("Train Departures.Train 2","Updating...")
call SetPropertyValue("Train Departures.Train 3","Updating...")
call SetPropertyValue("Train Departures.Train 4","Updating...")


Dim objXmlHttp
Set objXmlHttp = CreateObject("Msxml2.XMLHttp")

objXmlHttp.Open "POST", "http://pda.jcheck.com/c2c/route?from=Stanford-Le-Hope&type=departures", False
objXmlHttp.Send

Dim sContent
Dim sDep1 
Dim sDep2 
Dim sDep3 
Dim sDep4 

sContent = objXmlHttp.responseText


if InStr(sContent,"There are no services departing from")<>0 then
	sDep1 = "There are no services departing within the next hour."
else

	sContent = Mid(sContent,InStr(sContent,"secondaryHeadingRow"))

	'DEPT 1
	sContent = Mid(sContent,InStr(sContent,"scheduled")+24)
	sDep1 = Mid(sContent,1,InStr(sContent,"</td>")-1) & " - "
	sContent = Mid(sContent,InStr(sContent,"expected")+23)
	sDep1 = sDep1 & Mid(sContent,1,InStr(sContent,"</td>")-1) & " - "
	sContent = Mid(sContent,InStr(sContent,"DESTINATION")+44)
	sDep1 = sDep1 & Mid(sContent,1,InStr(sContent,"</td>")-1)
	
	'DEPT 2
	sContent = Mid(sContent,InStr(sContent,"scheduled")+24)
	sDep2 = Mid(sContent,1,InStr(sContent,"</td>")-1) & " - "
	sContent = Mid(sContent,InStr(sContent,"expected")+23)
	sDep2 = sDep2 & Mid(sContent,1,InStr(sContent,"</td>")-1) & " - "
	sContent = Mid(sContent,InStr(sContent,"DESTINATION")+44)
	sDep2 = sDep2 & Mid(sContent,1,InStr(sContent,"</td>")-1)

	'DEPT 3
	sContent = Mid(sContent,InStr(sContent,"scheduled")+24)
	sDep3 = Mid(sContent,1,InStr(sContent,"</td>")-1) & " - "
	sContent = Mid(sContent,InStr(sContent,"expected")+23)
	sDep3 = sDep3 & Mid(sContent,1,InStr(sContent,"</td>")-1) & " - "
	sContent = Mid(sContent,InStr(sContent,"DESTINATION")+44)
	sDep3 = sDep3 & Mid(sContent,1,InStr(sContent,"</td>")-1)

	'DEPT 4
	sContent = Mid(sContent,InStr(sContent,"scheduled")+24)
	sDep4 = Mid(sContent,1,InStr(sContent,"</td>")-1) & " - "
	sContent = Mid(sContent,InStr(sContent,"expected")+23)
	sDep4 = sDep4 & Mid(sContent,1,InStr(sContent,"</td>")-1) & " - "
	sContent = Mid(sContent,InStr(sContent,"DESTINATION")+44)
	sDep4 = sDep4 & Mid(sContent,1,InStr(sContent,"</td>")-1)

end if

call SetPropertyValue("Train Departures.Train 1",sDep1)
call SetPropertyValue("Train Departures.Train 2",sDep2)
call SetPropertyValue("Train Departures.Train 3",sDep3)
call SetPropertyValue("Train Departures.Train 4",sDep4)

Set objXmlHttp = Nothing


If Err.Number <> 0 Then
  TraceErrorMessage( "Script error in internet_feeds_c2c.vb : " & Err.Description )
  Err.Clear
End If

Google Account Phone Number Lookup

When the phone rings, I have this script lookup the phone number in my google account, as this is the same account as my android phone.

Code: Select all

On Error Resume Next

GoogleEmail = "[email protected]" 
GooglePassword = "PASSWORD" 
CountryCode = "0044"
HouseBotPhoneNumberProperty = "Phone.Last Phone Number" ' Device in housebot that has phone number to lookup
HouseBotLogProperty = "House Event.Message" ' Device in housebot that will report back the phone number in housebot

On Error Resume Next

Set objHTTP = CreateObject("Microsoft.XMLHTTP") 

objHTTP.Open "POST", "https://www.google.com/accounts/ClientLogin", FALSE 
objHTTP.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded" 
objHTTP.Send "Email=" + GoogleEmail + "&Passwd=" + GooglePassword + "&service=cp&source=HouseBotScript" 

If objHTTP.status <> 200 Then
	TraceErrorMessage ("Error with /accounts/ClientLogin: " & objHTTP.statusText )
Else
	'Get authentication string for the /m8/feeds/contacts call to google
	strAuthTokens = objHTTP.ResponseText	
	strAuthTokens = Replace(strAuthTokens, vbCr, "")
	strAuthTokens = Replace(strAuthTokens, vbLf, "")
	strAuthTokens = Replace(strAuthTokens, vbCrLf, "")
	strAuthTokens = Replace(strAuthTokens, "SID", "&SID", 1, 1)
	strAuthTokens = Replace(strAuthTokens, "LSID", "&LSID")
	strAuthTokens = Replace(strAuthTokens, "Auth", "&Auth")
	strAuthTokens = Right(strAuthTokens, Len(strAuthTokens)-Len("Auth=")-InStr(strAuthTokens, "Auth=")+1)
	
	'Get contacts from google
	objHTTP.Open "GET", "https://www.google.com/m8/feeds/contacts/default/full?max-results=999", FALSE
	objHTTP.SetRequestHeader "Authorization", "GoogleLogin auth=" & strAuthTokens
	objHTTP.Send
	
	'If successful will go off and find the name
	If objHTTP.status <> 200 Then
		TraceErrorMessage ("Error with /m8/feeds/contacts: " & objHTTP.statusText)
	Else	
		call SetPropertyValue(HouseBotLogProperty, "Phone call from " & FindContactUsingPhoneNumber(objHTTP.responseText,GetPropertyValue( HouseBotPhoneNumberProperty ) ) )
	End If
	
End If

Set objHTTP = Nothing

'Log any errors to HouseBot
If Err.Number <> 0 Then 
	'Add HouseBot Error Logging
	TraceErrorMessage ( Err.Description )
End If



'Function steps though google contacts and if there us a match returns the name, otherwise it will return number
Function FindContactUsingPhoneNumber(xmlToSearch, phoneNumber)

	'Set the return as the phone number, just in case if does not find anything and needs to return something
	FindContactUsingPhoneNumber = phoneNumber
	'Remove while space from phone number
	phoneNumber = Replace(phoneNumber," ","")
	
	Set objXml = CreateObject("Microsoft.XMLDOM")
	objXml.async = false
	objXml.loadxml (xmlToSearch)
	
	'Step through each google contact
	For Each NodeEntriy in objXml.selectNodes("/feed/entry")
		
		Set objXmlEntry = CreateObject("Microsoft.XMLDOM")
		
		objXmlEntry.async = false
		objXmlEntry.loadxml (NodeEntriy.xml)
	
		'Step through each phone numbber in the selected contact
		For Each NodePhoneNumbers in objXmlEntry.selectNodes("//gd:phoneNumber")
	
			NumberToMatch = NodePhoneNumbers.text 'Tidy up phone number so it can be matched
			NumberToMatch = Replace(NumberToMatch," ","") ' Remove whitespace 
			NumberToMatch = Replace(NumberToMatch,"++","00") 
			NumberToMatch = Replace(NumberToMatch,"+","00") ' Remove international ++ and replace with 00, same as callerid modem displays 
			If Instr(NumberToMatch,CountryCode) = 1 Then NumberToMatch = "0" & Mid(NumberToMatch,Len(CountryCode)+1) ' Removes CountryCode from phone numbers that are withing the same country
	
			'See if the numbers match, if so return name and exit function
			If phoneNumber = NumberToMatch Then
				FindContactUsingPhoneNumber = objXmlEntry.selectSingleNode("//title").text
				FindContactUsingPhoneNumber = FindContactUsingPhoneNumber & " " & Replace(NodePhoneNumbers.getAttribute("rel"),"http://schemas.google.com/g/2005#","")
				Exit Function
			End If
			
		Next
		
		Set objXmlEntry = Nothing
		
	Next

	Set objXml = Nothing
	
End Function

If Err.Number <> 0 Then
  TraceErrorMessage( "Script error in phone_lookup_google.vb : " & Err.Description )
  Err.Clear
End If

That's it for now

[jacco van der Ven]

I like it to see some scripts, I can learn from it and it brings me new idea's.

Thanks,
Jacco

[allanstevens]

Internet Radio Script Requires an Alpha property called 'Radio Presets' with the station names, that match the Select Case values in the code. Lots of internet radio stations on tunein.com.

Code: Select all

Dim CurrentlyPlaying 

SetPropertyValue "Internet Radio.Radio Presets", "Off"

Set objIE = CreateObject("InternetExplorer.Application") 
    objIE.Visible = 0 
    
	Do 

		' If preset has changed then navigate to new url/preset
		If GetPropertyValue("Internet Radio.Radio Presets") <> CurrentlyPlaying Then
			CurrentlyPlaying = GetPropertyValue("Internet Radio.Radio Presets")
			Select Case GetPropertyValue("Internet Radio.Radio Presets")
				Case "Off"
					objIE.Navigate "about:blank"
				Case "97.3 LBC"
					objIE.Navigate "http://tunein.com/tuner/?StationId=17569"
				Case "Absolute Radio"
					objIE.Navigate "http://tunein.com/tuner/?StationId=47769"
				Case "Heart Essex"
					objIE.Navigate "http://tunein.com/tuner/?StationId=43243"
			End Select
		End IF
		
		Sleep 1000
	
	Loop 

	objIE.Quit
Set objIE = Nothing 

[jacco van der Ven]

I use http://www.prowl.net to send notification to my iPhone,
you have to buy the Prowl app in the appstore.

Code: Select all

Option Explicit
On Error Resume Next

DIM API,priority,desc,oHTTP,HTTPPost,res,val,val1, Prio

API = "Your code from www.prowl.net"
SetPropertyValue "Prowl.Respons" , "Respons"
Prio = GetPropertyValue ("Prowl.Prioriteit")

' Prioriteit
'-2 = Geen Geluid
'-1 = Zacht
' 0 = Normaal
' 1 = Four beep
' 2 = Hard oneindig
priority = Prio

desc = GetPropertyValue("Prowl.Message")

set oHTTP = CreateObject("Microsoft.XMLHTTP")


oHTTP.open "Post", "https://prowl.weks.net/publicapi/add?"& "apikey=" & API & "&priority=" & priority & "&application=HomeServer &event=" & Date() & " " & Time() & "&description=" & desc ,false

oHTTP.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
oHTTP.send
HTTPPost = oHTTP.responseText
val = InStr(HTTPPost, "code=")+6
val1 = mid(HTTPPost, val, 3)

res= Trim(Replace(Replace(objHTTP.ResponseText, vbLf, ""), vbCr, "")) 
SetPropertyValue "Prowl.Respons" , val1