Home Automation Domotica Forum Europe, Bwired Forum

Code: Select all

' XBMCmd.vb
' by A.A. van Zoelen
' 
' Purpose : HomeSeer conrole script for XMBC v12.1
' Version : 0.13
'
' Makes use of XBMC JSON-RPC API v6 (Frodo)
' http://wiki.xbmc.org/index.php?title=JSON-RPC_API/v6
' More XBMC API info at
' http://wiki.xbmc.org/index.php?title=JSON-RPC_API
'
' Remark : Still in heavy testing/debug/discovery fase!
'	   Usage at your own risk!
'
' Available commands this far:
'----------------------------------------------------------------
' PLAYPAUSE  		Pauses or unpause playback and 
'			returns the new state
'			Parameters : PlayerId (when omitted it will be 0)

' RESTART  		Restart the XBMC system
'			Parameters : None

' SHOWNOTIFICATION	Display a message on the XBMC system
'			Parameters : Title;Message;DisplayTime

' XPING			Check if the XBMC system is available
'			Parameters : None

Imports system.IO
Imports system.Text
Imports system.Net
'=================================================
'=================================================
' Fill in your settings
Dim IP As String         	= "192.168.1.56"
Dim PORT As String	 	= "8081"
Dim REPORTDEVICE As String	= ""
Dim DEBUG As Boolean     	= True
'=================================================
'=================================================
' No need to change things below this line
'Make this variable global
Dim strBaseURL As String = ""


Sub Main(ByVal Params As Object)
	'Base string for the URL
	strBaseURL = "http://" & IP 

	If (Len(PORT) > 0) Then strBaseURL = strBaseURL & ":" & PORT
	strBaseURL = strBaseURL & "/jsonrpc?request={""jsonrpc"":""2.0"",""method"":"

	If DEBUG = True Then hs.writelog("<b>XBMCcmd</b>", strBaseURL)
	If DEBUG = True Then hs.writelog("<b>XBMCcmd</b>", "HS.Ping status of " & IP & " is " & hs.ping(IP))

	Dim strReply As String   = ""
	Dim blnStatus As Boolean = False

	'Parse command
	Dim strAction as String = UCASE(Trim(hs.StringItem(Params, 1, ";") ) )

	'Check if the system is available
	If hs.ping(IP) = 1 Then
	  ' Please note that the ping protocol can't ping ports
	  ' If you want to check if XBMC itself is running then
	  ' use the XPING command
	  hs.writelog("<b>XBMCcmd</b>","<b>No reply from " & IP & "<br>(without portnumber because Ping can not test on portnumbers)</b>")
	  Exit Sub
	End If



	If DEBUG = True Then hs.writelog("XBMCcmd","Passed HS.Ping")

	'Do Commands
	If strAction = "PLAYPAUSE" Then 
	  strReply = PlayPause(hs.StringItem(Params, 2, ";"))
	  blnStatus = True
	End If

	If strAction = "RESTART" Then strReply = DoRestart() : blnStatus = True

	If strAction = "SHOWNOTIFICATION" Then 
	  strReply = ShowNotification(hs.StringItem(Params, 2, ";"), hs.StringItem(Params, 3, ";"), hs.StringItem(Params, 4, ";"))
	  blnStatus = True
	End If

	If strAction = "XPING" Then strReply = DoPing() : blnStatus = True



	If blnStatus = False Then hs.writelog("XBMC", "Unknow action:" & strAction)

	If strReply <> "" Then 
	  If DEBUG = True Then hs.writelog("XBMC", strAction & " : " & strReply)
	  If REPORTDEVICE <> "" Then
	    hs.setdevicestring(REPORTDEVICE, strReply)
	  End If
	End If

	If DEBUG = True Then hs.writelog("XBMCcmd","Script ready")

End Sub

'=======================
'== AVAILABLE ACTIONS ==
'=======================
' RESTART  		Restart the XBMC system
'			Parameters : None
Function DoRestart() As String
	Dim strURL As STring   = ""
	strURL = strBaseURL  & """System.Reboot""}"
	If DEBUG = True Then hs.writelog("XBMC", "JSON URL : " & strURL)
	Return hs.urlaction(strURL,"GET","","")
End Function


'==========================================================
' SHOWNOTIFICATION	Display a message on the XBMC system
'			Parameters : Title;Message;DisplayTime
Function ShowNotification(ByVal strTitle As String, ByVal strMessage As String, ByVal intDisplayTime As Integer) As String
	Dim strURL As STring   = ""

	'action
	strURL = strBaseURL + """GUI.ShowNotification"","
	'Parameters
	strURL = strURL + """params"":{""title"":" & chr(34) & strTitle & chr(34) & ",""message"":" & chr(34) & strMessage & chr(34) & ",""displaytime"":" & intDisplayTime & "}}"

	If DEBUG = True Then hs.writelog("XBMC", "JSON URL : " & strURL)

	Return hs.urlaction(strURL,"GET","","")
End Function

'==========================================================
' PLAYPAUSE  		Pauses or unpause playback and 
'			returns the new state
'			Parameters : PlayerId
Function PlayPause(ByVal strPlayerId As String) As String
	Dim strURL As STring   = ""

	If strPlayerId = "" Then strPlayerId = "0"

	'action
	strURL = strBaseURL + """Player.PlayPause"","
	'Parameters
	strURL = strURL + """params"":{""playerid"":" & strPlayerId & "},""id"": 1}"

	If DEBUG = True Then hs.writelog("XBMC", "JSON URL : " & strURL)

	Return hs.urlaction(strURL,"GET","","")
End Function
'==========================================================
' XPING			Check if the system is available
'			Parameters : None
Function DoPing() As String
	Dim strURL As STring   = ""
        strURL = strBaseURL + """JSONRPC.Ping"", ""id"": ""1""}"
	If DEBUG = True Then hs.writelog("XBMC", "JSON URL : " & strURL)
	Return hs.urlaction(strURL,"GET","","")
End Function
'==========================================================