En wat betreft hstouch.. Kleine stapjes graag want ik werk in het donker zo gezegt.
Ik moet eerst leren kruipen voordat ik kan gaan proberen te rennen

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
'==========================================================