Gå til innhold
  • Bli medlem

SCRIPT: GrandbeingMX0404 - Styring av en 4x4 HDMI-matrise


Moskus
 Del

Anbefalte innlegg

GrandbeingMX0404.vb

Script for å styre en Grandbeing MX0404 HDMI matrise. Lager en root med tilhørende child-devicer for hver utgang hvor man kan trykke på de forskjellige inngangene. Alt i et script, men dette blir nok en plugin på sikt (der er det lettere å få til en autorefresh, og sånt).

    '© Moskus 2014
    
    Dim Scriptname As String = "GrandbeingMX0404.vb"
    Dim hdmi_outputs() As String = {"None", "TV", "SageTV", "Xbox", "Extra"}
    Dim ip_address As String = "192.168.0.39"

    Public Sub Main(parm As Object)
    End Sub

    Public Sub Setup(parm As Object)
        'Setting up devices

        'Creating master device
        Dim dt As New HomeSeerAPI.DeviceTypeInfo
        Dim devref As Integer = hs.NewDeviceRef("Root")
        Dim dv As Scheduler.Classes.DeviceClass = hs.GetDeviceByRef(devref)
        Try
            dv.Location(hs) = "HDMI matrix"
            dv.Location2(hs) = "Media"
            dv.Device_Type_String(hs) = "HDMI root"
            dv.DeviceType_Set(hs) = New HomeSeerAPI.DeviceTypeInfo
            dv.Status_Support(hs) = True
            dv.Can_Dim(hs) = False
            hs.SaveEventsDevices()
            dv.MISC_Set(hs, HomeSeerAPI.Enums.dvMISC.SHOW_VALUES)
            dv.MISC_Clear(hs, HomeSeerAPI.Enums.dvMISC.STATUS_ONLY)

            'Adding a "Refresh" button to the root device
            hs.DeviceScriptButton_AddButton(devref, "Refresh", 0, Scriptname, "ButtonPress", "Refresh", 1, 1, 1)
            hs.SaveEventsDevices()

            Dim SVpair As New HomeSeerAPI.VSPair(HomeSeerAPI.ePairStatusControl.Status)
            SVpair.PairType = HomeSeerAPI.VSVGPairType.SingleValue
            SVpair.Value = 0
            SVpair.Status = "HDMI matrix"
            hs.DeviceVSP_AddPair(devref, SVpair)

            Dim VGpair As New HomeSeerAPI.VGPair
            VGpair.PairType = HomeSeerAPI.VSVGPairType.SingleValue
            VGpair.Set_Value = 0
            VGpair.Graphic = "images/Moskus/icon_hdmi.png"
            hs.DeviceVGP_AddPair(devref, VGpair)

            hs.WriteLog("HDMI matrix", "Root device for HDMI matrix created")
        Catch ex As Exception
            hs.WriteLog("HDMI matrix", "Error creating root device: " & ex.Message)
        End Try

        'Creating child devices
        dv.Relationship(hs) = HomeSeerAPI.Enums.eRelationship.Parent_Root
        For i As Integer = 1 To 4
            Dim childref As Integer = CreateOutputDevice(i, devref)
            If childref > 0 Then dv.AssociatedDevice_Add(hs, childref)
        Next

    End Sub

    Public Function CreateOutputDevice(ByVal output As Integer, masterdevice As Integer) As Integer
        'Creating device
        Dim dt As New HomeSeerAPI.DeviceTypeInfo
        Dim devref As Integer = hs.NewDeviceRef("Output " & output)
        Dim dv As Scheduler.Classes.DeviceClass = hs.GetDeviceByRef(devref)
        Try
            dv.Location(hs) = "HDMI matrix"
            dv.Location2(hs) = "Media"
            dv.Device_Type_String(hs) = "HDMI out " & output
            dv.DeviceType_Set(hs) = New HomeSeerAPI.DeviceTypeInfo
            hs.SaveEventsDevices()
            dv.Status_Support(hs) = True
            dv.Can_Dim(hs) = False
            dv.MISC_Set(hs, HomeSeerAPI.Enums.dvMISC.SHOW_VALUES)
            dv.MISC_Clear(hs, HomeSeerAPI.Enums.dvMISC.STATUS_ONLY)
            dv.Relationship(hs) = HomeSeerAPI.Enums.eRelationship.Child
            dv.AssociatedDevice_Add(hs, masterdevice)
            dv = Nothing

            hs.WriteLog("HDMI matrix", "Test Device for output " & output & " created")
        Catch ex As Exception
            hs.WriteLog("HDMI matrix", "Error creating devices: " & ex.Message)
            Return 0
        End Try

        Dim SVpair_off As New HomeSeerAPI.VSPair(HomeSeerAPI.ePairStatusControl.Status)
        SVpair_off.PairType = HomeSeerAPI.VSVGPairType.SingleValue
        SVpair_off.Value = 0
        SVpair_off.Status = "None"
        hs.DeviceVSP_AddPair(devref, SVpair_off)

        Dim VGpair_off As New HomeSeerAPI.VGPair
        VGpair_off.PairType = HomeSeerAPI.VSVGPairType.SingleValue
        VGpair_off.Set_Value = 0
        VGpair_off.Graphic = "images/Moskus/icon_hdmi_X.png"
        hs.DeviceVGP_AddPair(devref, VGpair_off)


        'Adding buttons, values and graphic
        For i As Integer = 1 To 4
            hs.DeviceScriptButton_AddButton(devref, output & "-" & i, i, Scriptname, "ButtonPress", output & "-" & i, 1, i, 1)

            Dim SVpair As New HomeSeerAPI.VSPair(HomeSeerAPI.ePairStatusControl.Status)
            SVpair.PairType = HomeSeerAPI.VSVGPairType.SingleValue
            SVpair.Value = i
            SVpair.Status = "Input " & i
            hs.DeviceVSP_AddPair(devref, SVpair)

            Dim VGpair As New HomeSeerAPI.VGPair
            VGpair.PairType = HomeSeerAPI.VSVGPairType.SingleValue
            VGpair.Set_Value = i
            VGpair.Graphic = "images/Moskus/icon_hdmi_" & i & ".png"
            hs.DeviceVGP_AddPair(devref, VGpair)
        Next

        Return devref
    End Function

    Public Sub ButtonPress(Input As Object)
        Dim devref As Integer = Input(0)
        Dim ButtonName As String = Input(1)
        Dim output As String = String.Empty 'Gets filled by GetURLIE

        Dim device As Integer = 0

        Dim master As Integer = hs.GetDeviceParentRefByRef(devref)
        If master = 0 Then master = devref

        Dim dv As Scheduler.Classes.DeviceClass = hs.GetDeviceByRef(master)
        For Each devid As Integer In dv.AssociatedDevices(hs)
            Dim dev As Scheduler.Classes.DeviceClass = hs.GetDeviceByRef(devid)
            Select Case dev.Device_Type_String(hs)
                Case Is = "HDMI root"
                    device = 0
                Case Is = "HDMI out 1"
                    device = 1
                Case Is = "HDMI out 2"
                    device = 2
                Case Is = "HDMI out 3"
                    device = 3
                Case Is = "HDMI out 4"

            End Select
        Next

        Dim command As String = "Refresh"

        If device > 0 Then
            Dim value As Integer = hdmi_outputs.ToList.IndexOf(ButtonName)
            command = device & "-" & value
        End If


        Select Case command
            Case Is = "Refresh"
                output = hs.GetURLIE("http://" & ip_address & "/get_data?type=refrash", True) '"refrash" is actually not a typo on my part...

            Case Is = "1-1"
                output = hs.GetURLIE("http://" & ip_address & "/get_data?type=port&cmd=a09", True)
            Case Is = "1-2"
                output = hs.GetURLIE("http://" & ip_address & "/get_data?type=port&cmd=a1D", True)
            Case Is = "1-3"
                output = hs.GetURLIE("http://" & ip_address & "/get_data?type=port&cmd=a1F", True)
            Case Is = "1-4"
                output = hs.GetURLIE("http://" & ip_address & "/get_data?type=port&cmd=a0D", True)

            Case Is = "2-1"
                output = hs.GetURLIE("http://" & ip_address & "/get_data?type=port&cmd=a17", True)
            Case Is = "2-2"
                output = hs.GetURLIE("http://" & ip_address & "/get_data?type=port&cmd=a12", True)
            Case Is = "2-3"
                output = hs.GetURLIE("http://" & ip_address & "/get_data?type=port&cmd=a59", True)
            Case Is = "2-4"
                output = hs.GetURLIE("http://" & ip_address & "/get_data?type=port&cmd=a08", True)

            Case Is = "3-1"
                output = hs.GetURLIE("http://" & ip_address & "/get_data?type=port&cmd=a5E", True)
            Case Is = "3-2"
                output = hs.GetURLIE("http://" & ip_address & "/get_data?type=port&cmd=a06", True)
            Case Is = "3-3"
                output = hs.GetURLIE("http://" & ip_address & "/get_data?type=port&cmd=a05", True)
            Case Is = "3-4"
                output = hs.GetURLIE("http://" & ip_address & "/get_data?type=port&cmd=a03", True)

            Case Is = "4-1"
                output = hs.GetURLIE("http://" & ip_address & "/get_data?type=port&cmd=a18", True)
            Case Is = "4-2"
                output = hs.GetURLIE("http://" & ip_address & "/get_data?type=port&cmd=a44", True)
            Case Is = "4-3"
                output = hs.GetURLIE("http://" & ip_address & "/get_data?type=port&cmd=a0F", True)
            Case Is = "4-4"
                output = hs.GetURLIE("http://" & ip_address & "/get_data?type=port&cmd=a51", True)
        End Select

        InterpretOutput(devref, output)
    End Sub

    Public Sub InterpretOutput(ByVal devref As Integer, ByVal output As String)
        'output: Output1=1Output2=1Output3=1Output4=1
        Dim data(3) As Integer
        data(0) = CInt(output(8).ToString)
        data(1) = CInt(output(17).ToString)
        data(2) = CInt(output(26).ToString)
        data(3) = CInt(output(35).ToString)

        Dim master As Integer = hs.GetDeviceParentRefByRef(devref)
        If master = 0 Then master = devref

        Dim dv As Scheduler.Classes.DeviceClass = hs.GetDeviceByRef(master)
        For Each devid As Integer In dv.AssociatedDevices(hs)
            Dim dev As Scheduler.Classes.DeviceClass = hs.GetDeviceByRef(devid)
            Select Case dev.Device_Type_String(hs)
                Case Is = "HDMI out 1"
                    If hs.DeviceValue(devid) <> data(0) Then
                        hs.SetDeviceValueByRef(devid, data(0), True)
                    Else
                        hs.SetDeviceValueByRef(devid, data(0), False)
                    End If
                Case Is = "HDMI out 2"
                    If hs.DeviceValue(devid) <> data(1) Then
                        hs.SetDeviceValueByRef(devid, data(1), True)
                    Else
                        hs.SetDeviceValueByRef(devid, data(1), False)
                    End If
                Case Is = "HDMI out 3"
                    If hs.DeviceValue(devid) <> data(2) Then
                        hs.SetDeviceValueByRef(devid, data(2), True)
                    Else
                        hs.SetDeviceValueByRef(devid, data(2), False)
                    End If
                Case Is = "HDMI out 4"
                    If hs.DeviceValue(devid) <> data(3) Then
                        hs.SetDeviceValueByRef(devid, data(3), True)
                    Else
                        hs.SetDeviceValueByRef(devid, data(3), False)
                    End If
            End Select
        Next

    End Sub

 

Gir:

nEibCgm.png

  • Like 1
Lenke til kommentar
Del på andre sider

  • 3 uker senere...

Jeg har laget en ett matrise oppsett med VIrtuelle Devicer, men mine innganger er ikke gruppert sånn som dine. Jeg ser du gjør dette via ett script, betyr det at devicene blir opprettet hver gang du kjører dette scriptet. Når kjører du det ? Er det mulig å gruppere devicer i fra Websiden, eller må dette gjøres vha script ?

Lenke til kommentar
Del på andre sider

Som du ser i scriptet har jeg en "Setup()" rutine.

Her er "dv" root-devicen, og siste delen lager children og assosierer dem med root:

'Creating child devices
dv.Relationship(hs) = HomeSeerAPI.Enums.eRelationship.Parent_Root
For i As Integer = 1 To 4
    Dim childref As Integer = CreateOutputDevice(i, devref)
    If childref > 0 Then dv.AssociatedDevice_Add(hs, childref)
Next

 

Lenke til kommentar
Del på andre sider

  • 10 måneder senere...

Bli med i samtalen

Du kan publisere innhold nå og registrere deg senere. Hvis du har en konto, logg inn nå for å poste med kontoen din.

Gjest
Skriv svar til emnet...

×   Du har limt inn tekst med formatering.   Lim inn uten formatering i stedet

  Du kan kun bruke opp til 75 smilefjes.

×   Lenken din har blitt bygget inn på siden automatisk.   Vis som en ordinær lenke i stedet

×   Tidligere tekst har blitt gjenopprettet.   Tøm tekstverktøy

×   Du kan ikke lime inn bilder direkte. Last opp eller legg inn bilder fra URL.

 Del

  • Lignende innhold

    • Av Moskus
      Det hender jeg eksperimenterer med Z-wave, til og med på hovedsystemet. Jeg har et par Z-wave-interfacer jeg bytter mellom (kjører restore av backup til et nytt interface før for mye testing), og det fjerner all potensiell routing-informasjon. I løpet av de første timene prøver altså huset å "finne seg selv", alt går litt tregt, og det blir høyere risiko for at noe er satt til "Unknown".
       
      Jeg skrev et script for å finne disse enhetene, og så polle dem for å faktisk lese statusen de har. Det hjelper både for å få fjernet de irriterende "Unknown"-status'ene, og det hjelper på å bedre routingen fordi kommandoen blir utført.
       
      For at dette skal fungere ut av esken må HomeSeer finne seg selv på localholst på port 80. Hvis ikke må du endre "Dim url as String"-linja.
       
      CheckForUnknown.vb
      Public Sub Main(ByVal params As Object) 'Moskus 2020 Dim subStart As DateTime = DateTime.UtcNow Dim url As String = "http://localhost/json?request=getstatus" Dim json As String = "" Dim DEBUG As Boolean = False If DEBUG Then hs.WriteLog("CheckForErrors", "Downloading data... ") Using client As New System.Net.WebClient json = client.DownloadString(url) json = json.ToLower() End Using If DEBUG Then hs.WriteLog("CheckForErrors", "Download done!") Dim searchString As String = ("{""ref"":").ToLower() Dim errorSearchString As String = ("""status"":""Unknown"",""device_type_string"":""Z-Wave Switch").ToLower() Dim lst As New System.Collections.Generic.List(Of Integer) Dim start As Integer = 0 If json.IndexOf(errorSearchString) > 0 Then ' Yes, we have errors, lets find the devices by looping through all devices While start <> -1 Dim deviceJsonStart As Integer = json.IndexOf(searchString, start) If deviceJsonStart = -1 Then Exit While Dim deviceJsonEnd As Integer = json.IndexOf(searchString, deviceJsonStart + searchString.Length) If deviceJsonEnd = -1 Then Exit While Dim deviceJson As String = json.Substring(deviceJsonStart, deviceJsonEnd - deviceJsonStart) 'This is the JSON for a device If deviceJson.Contains(errorSearchString) Then 'Check if the device contains the error and get the deviceRef if it doesn't Dim deviceRef As Integer = deviceJson.Substring(searchString.Length, deviceJson.IndexOf(",") - searchString.Length) lst.Add(deviceRef) If DEBUG Then hs.WriteLog("CheckForErrors", "Found reference '" + deviceRef.ToString + "'") End If start = json.IndexOf(searchString, deviceJsonStart + 10) End While End If For Each d As Integer In lst Dim dev As Scheduler.Classes.DeviceClass = hs.GetDeviceByRef(d) Dim devName As String = dev.Location2(hs) & ", " & dev.Location(hs) & ", " & dev.Name(hs) Dim pollResult As HomeSeerAPI.IPlugInAPI.PollResultInfo = hs.PluginFunction("Z-Wave", "", "PollDevice", New Object() {d}) hs.WriteLog("CheckForErrors", "Poll of device " & d.ToString & " (" & devName & ") returned " & pollResult.Result.ToString & " (" & pollResult.Value & ")") 'Check if the device has the correct value If pollResult.Result = HomeSeerAPI.IPlugInAPI.enumPollResult.OK OrElse pollResult.Result = HomeSeerAPI.IPlugInAPI.enumPollResult.Timeout_OK Then Dim pollValue As Integer = pollResult.Value Dim devValue As Integer = hs.DeviceValue(d) 'Set the device to the correct value If devValue <> pollValue Then For Each CAPI As HomeSeerAPI.CAPIControl In hs.CAPIGetControl(d) If CAPI.ControlValue = devValue Then Dim response As CAPIControlResponse = hs.CAPIControlHandler(CAPI) hs.WriteLog("CheckForErrors", "Set " & d.ToString & " (" & devName & ") to " & CAPI.Label & ": " & response.ToString) Exit For End If Next End If End If Next hs.WriteLog("CheckForErrors", "Done! Elapsed time: " & Math.Round(DateTime.UtcNow.Subtract(subStart).TotalSeconds, 2) & " seconds") End Sub  
       

       
      Jeg kjører dette scriptet i et event hver 10. minutt. Men jeg har også en begrensning på at det ikke må ha vært bevegelse i huset i løpet av 5 minutter for å redusere trafikken når routingen er på det verste.
       
      Jeg hadde selvfølgelig tenkt å disable scriptet når det ikke var behov for det, men ellers merker jeg ikke noe til det for det er særdeles sjeldent scriptet finner "Unknown" lenger, det ser jeg jo nå i loggen.
    • Av Moskus
      Sub Main(ByVal input As Object) Dim deviceRef As Integer = input.ToString Dim weekNumber As Integer = DatePart(DateInterval.WeekOfYear, Date.Now, FirstDayOfWeek.Monday, FirstWeekOfYear.System) hs.SetDeviceValueByRef(input, weekNumber, True) hs.SetDeviceString(input, "Uke " & weekNumber, False) End Sub  
    • Av Moskus
      Det er det samme maset hvert år: "Hvorfor må vi alltid ha disse kjedelige juletrelysene? Klart jeg kan bruke RGBW-lys, men de er så... statiske.". Vi har alle vært der.
       
      Vel, Twinkly er svaret. Det er juletrelys som kan styres via en app, man kan legge til animasjoner, og man kan til og med lage egne og "tegne" fargene på treet i sanntid. Og nå kan man også selvfølgelig styre treet fra HomeSeer.
       
      Lagre scriptet under som Twinkly.vb i /scripts-mappen, endre IPen (nest øverste linje), og lag et event der du kjører "Setup"-funksjonen. Hvis du oppdaterer, så kan du istedenfor kjøre "AddDeviceButtons"-funksjonen og bruke deviceID'en til eksisterende Twinkly-devicer som parameter (en om gangen).
       
      Twinkly.vb
       
      'Moskus 2019-2020 Dim IP As String Dim debug As Boolean = False Public Sub Main(ByVal something As Object) End Sub Public Sub ButtonPress(ByVal input As Object) Dim deviceRef As Integer = input(0) IP = DirectCast(hs.GetDeviceByRef(deviceRef), Scheduler.Classes.DeviceClass).Device_Type_String(hs) Dim cmd As String = input(1) If cmd.StartsWith("Brightness_") Then Dim value As Integer = cmd.Split("_")(1) DoCmd("Brightness", value) Else If DoCmd(cmd) Then hs.SetDeviceString(deviceRef, cmd, True) End If If DoCmd(cmd) Then hs.SetDeviceString(deviceRef, cmd.Replace("_", " "), True) End Sub Public Function DoCmd(ByVal command As String, Optional ByVal value As Integer = 100) As Boolean 'SetMode("rt") 'SetMode("demo") 'SetMode("movie") 'SetMode("effect") 'SetMode("off") If debug Then hs.WriteLog("Twinkly", "Starting DoCmd()") Dim code As String = GetRandomCode() If debug Then hs.WriteLog("Twinkly", "Code: " & code) Dim auth As TwinklyAuthentication = Login(code, forceNew:=True) If debug Then hs.WriteLog("Twinkly", "Authentication_token: " & auth.authentication_token) Dim success As Boolean = Verify() If debug Then hs.WriteLog("Twinkly", "Verified: " & success) If command = "Brightness" Then SetBrightness(value) Else SetMode(command) End If Return True End Function Public Sub Setup(ByVal not_used As String) Dim new_ref As Integer = hs.NewDeviceRef("Twinkly") Dim dv As Scheduler.Classes.DeviceClass = hs.GetDeviceByRef(new_ref) dv.Location(hs) = "Twinkly" dv.Location2(hs) = "Twinkly" dv.Can_Dim(hs) = False dv.DeviceType_Set(hs) = New HomeSeerAPI.DeviceTypeInfo dv.Status_Support(hs) = True dv.Can_Dim(hs) = False dv.MISC_Set(hs, HomeSeerAPI.Enums.dvMISC.SHOW_VALUES) 'This is &H100 dv.MISC_Clear(hs, HomeSeerAPI.Enums.dvMISC.STATUS_ONLY) 'This is &H10 hs.SaveEventsDevices() AddDeviceButtons(new_ref) hs.WriteLog("Twinkly", "Initiation done!") End Sub Public Sub AddDeviceButtons(ByVal device_ref As String) Dim devID As Integer = CInt(device_ref) hs.DeviceScriptButton_DeleteAll(devID) hs.DeviceProperty_dvMISC(device_ref, HomeSeerAPI.Enums.eDeviceProperty.MISC_Set, HomeSeerAPI.Enums.dvMISC.SHOW_VALUES) Try hs.WriteLog("Twinkly", "Added button 1: " & hs.DeviceScriptButton_AddButton(devID, "Movie", 101, "Twinkly.vb", "ButtonPress", "Movie", 1, 1, 1)) hs.WriteLog("Twinkly", "Added button 2: " & hs.DeviceScriptButton_AddButton(devID, "Effect", 102, "Twinkly.vb", "ButtonPress", "Effect", 1, 2, 1)) hs.WriteLog("Twinkly", "Added button 3: " & hs.DeviceScriptButton_AddButton(devID, "Demo", 103, "Twinkly.vb", "ButtonPress", "Demo", 1, 3, 1)) hs.WriteLog("Twinkly", "Added button 4: " & hs.DeviceScriptButton_AddButton(devID, "Pause", 104, "Twinkly.vb", "ButtonPress", "RT", 1, 4, 1)) hs.WriteLog("Twinkly", "Added button 5: " & hs.DeviceScriptButton_AddButton(devID, "Off", 0, "Twinkly.vb", "ButtonPress", "Off", 1, 5, 1)) For i As Integer = 10 To 100 Step 10 hs.WriteLog("Twinkly", "Added dimming " & i & " : " & hs.DeviceScriptButton_AddButton(devID, (i & "%").ToString, i, "Twinkly.vb", "ButtonPress", "Brightness_" & i, 2 + Math.Floor(i / 51), (i / 10 - Math.Floor(i / 51) * 5), 1)) Next Catch ex As Exception hs.WriteLog("Twinkly", "Error adding buttons: " & ex.Message) End Try End Sub Public Sub SetMovieConfig(ByVal frameDelay As Integer, ByVal numberOfLEDs As Integer, ByVal framesNumber As Integer, ByVal loopType As Integer) Dim data As New System.Collections.Generic.Dictionary(Of String, Integer) data.Add("frame_delay", frameDelay) data.Add("leds_number", numberOfLEDs) data.Add("frames_number", framesNumber) Dim output As String = RunAPI("led/movie/config", Newtonsoft.Json.JsonConvert.SerializeObject(data)) If debug Then hs.WriteLog("Twinkly", "SetMovieConfig: " & output) End Sub Public Sub GetMovieConfig() ' {"frame_delay":66,"leds_number":175,"loop_type":0,"frames_number":212,"sync":{"mode":"none","slave_id":"","master_id":""},"code":1000} Dim output As String = RunAPI("led/movie/config") If debug Then hs.WriteLog("Twinkly", "GetMovieConfig: " & output) End Sub Public Sub GetMovieFull() If debug Then hs.WriteLog("Twinkly", "GetMovieFull: ") Dim output As Byte() = RunAPIraw("led/movie/all") If debug Then hs.WriteLog("Twinkly", ConvertByteArrayToString(output) & " ... done!") End Sub Public Sub SetMovieFull(ByVal octetString As String) Dim movie() As Byte = ConvertStringToByteArray(octetString) If debug Then hs.WriteLog("Twinkly", "SetMovieFull: ") Dim ret = RunAPIraw("led/movie/full", movie) If debug Then hs.WriteLog("Twinkly", System.Text.Encoding.ASCII.GetString(ret) & " ... done!") End Sub ''' <summary> ''' Get brightness ''' </summary> Public Function GetBrightness() As Integer Console.Write("Getting brigthness...") Dim output As String = RunAPI("led/out/brightness") Dim json = Newtonsoft.Json.JsonConvert.DeserializeObject(Of Object)(output) Return json("value") End Function ''' <summary> ''' Set brightness ''' </summary> ''' <param name="brightness">0-100</param> Public Sub SetBrightness(ByVal brightness As Integer) If debug Then hs.WriteLog("Twinkly", "Setting brigthness to '" & brightness & "'...") Dim data As New System.Collections.Generic.Dictionary(Of String, Object) data.Add("mode", "enabled") data.Add("value", brightness) data.Add("type", "A") Dim output As String = RunAPI("led/out/brightness", Newtonsoft.Json.JsonConvert.SerializeObject(data)) If debug Then hs.WriteLog("Twinkly", IIf(output.Contains("1000"), " was a success!", " failed. :(")) End Sub ''' <summary> ''' Sets the display ''' </summary> ''' <param name="mode">rt, movie, demo, restart, effect, off</param> Public Sub SetMode(ByVal mode As String) If debug Then hs.WriteLog("Twinkly", "Setting mode to '" & mode & "'") Dim data As New System.Collections.Generic.Dictionary(Of String, String) data.Add("mode", mode.ToLower()) Dim output As String = RunAPI("led/mode", Newtonsoft.Json.JsonConvert.SerializeObject(data)) Dim success As Boolean = output.Contains("1000") If debug Then hs.WriteLog("Twinkly", "Mode set: " & IIf(success, " was a success!", " failed. :(")) If Not success And debug Then hs.WriteLog("Twinkly", "Output: " & output) End Sub Public Function GetAuthentication() As TwinklyAuthentication Dim auth As TwinklyAuthentication = New TwinklyAuthentication Dim authString As String = hs.GetINISetting("Twinkly", "Authentication", "", "Twinkly.ini") Try If authString <> "" Then auth = Newtonsoft.Json.JsonConvert.DeserializeObject(Of TwinklyAuthentication)(authString) End If Catch ex As Exception End Try Return auth End Function Public Function Verify() As Boolean Dim auth As TwinklyAuthentication = GetAuthentication() Dim data As New System.Collections.Generic.Dictionary(Of String, String) data.Add("challenge-response", auth.challengeresponse) Dim output As String = RunAPI("verify", Newtonsoft.Json.JsonConvert.SerializeObject(data)) Return output.Contains("1000") End Function Public Function Login(ByVal challenge As String, Optional ByVal forceNew As Boolean = False) As TwinklyAuthentication Dim auth As TwinklyAuthentication = Nothing Dim authString As String = "" authString = hs.GetINISetting("Twinkly", "Authentication", "", "Twinkly.ini") Try If authString <> "" Then auth = Newtonsoft.Json.JsonConvert.DeserializeObject(Of TwinklyAuthentication)(authString) Catch ex As Exception End Try If auth Is Nothing OrElse forceNew Then Dim data As New System.Collections.Generic.Dictionary(Of String, String) data.Add("challenge", challenge) Dim output As String = RunAPI("login", Newtonsoft.Json.JsonConvert.SerializeObject(data)) hs.SaveINISetting("Twinkly", "Authentication", output, "Twinkly.ini") auth = Newtonsoft.Json.JsonConvert.DeserializeObject(Of TwinklyAuthentication)(output) End If Return auth End Function Private Function RunAPI(ByVal urlFunction As String, Optional ByVal query As String = "") As String Dim source As String = "" Dim url As String = "http://" & IP & "/xled/v1/" & urlFunction Dim auth As TwinklyAuthentication = GetAuthentication() Using client As New System.Net.WebClient client.Headers.Add("Content-Type", "application/json") If auth.authentication_token <> "" Then client.Headers.Add("X-Auth-Token", auth.authentication_token) End If If query <> "" Then source = client.UploadString(url, "POST", query) Else source = client.DownloadString(url) End If End Using Return source End Function Private Function RunAPIraw(ByVal urlFunction As String, Optional ByVal bytes() As Byte = Nothing) As Byte() Dim auth As TwinklyAuthentication = GetAuthentication() Dim source As Byte() = {} Dim url As String = "http://" & IP & "/xled/v1/" & urlFunction Using client As New System.Net.WebClient Net.ServicePointManager.DefaultConnectionLimit = 9999 client.Headers.Add("Content-Type", "application/octet-stream") If auth.authentication_token <> "" Then client.Headers.Add("X-Auth-Token", auth.authentication_token) End If If bytes IsNot Nothing Then source = client.UploadData(New Uri(url), bytes) Else source = client.DownloadData(url) End If End Using Return source End Function Public Function GetRandomCode(Optional ByVal forceNew As Boolean = False) As String Dim code As String = hs.GetINISetting("Twinkly", "Code", "", "Twinkly.ini") If code = "" OrElse forceNew Then code = GetRandomString(32) hs.SaveINISetting("Twinkly", "Code", code, "Twinkly.ini") End If Return code End Function Private Function GetRandomString(ByVal length As Integer) Dim s As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789" Dim r As New Random Dim sb As New Text.StringBuilder For i As Integer = 0 To length - 1 Dim idx As Integer = r.Next(0, 35) sb.Append(s.Substring(idx, 1)) Next Return sb.ToString() End Function Public Function ConvertStringToByteArray(ByVal input As String) As Byte() Dim lst As New System.Collections.Generic.List(Of Byte) For i As Integer = 0 To input.Length - 1 Step 2 Dim temp As String = input.Substring(i, 2) Dim val As Integer = Convert.ToInt32(temp, 16) lst.Add(Convert.ToByte(val)) Next Return lst.ToArray() End Function Public Function ConvertByteArrayToString(ByVal bytes() As Byte) As String Dim ret As String = "" For Each b As Byte In bytes ret &= Convert.ToChar(b).ToString() Next Return ret End Function Public Class TwinklyAuthentication Private _authentication_token As String Public Property authentication_token() As String Get Return _authentication_token End Get Set(ByVal value As String) _authentication_token = value End Set End Property Private _authentication_token_expires_in As Integer Public Property authentication_token_expires_in() As Integer Get Return _authentication_token_expires_in End Get Set(ByVal value As Integer) _authentication_token_expires_in = value End Set End Property Private _challengeresponse As String Public Property challengeresponse() As String Get Return _challengeresponse End Get Set(ByVal value As String) _challengeresponse = value End Set End Property Private _code As Integer Public Property code() As Integer Get Return _code End Get Set(ByVal value As Integer) _code = value End Set End Property End Class  
       
       
      Gammelt script:
       
       
      Da får du en device som dette:

      Gå inn på Devicen, og gå til Advanced.
       
      Legg så IP-adressen til Twinkly-lenken inn under "Device Type (String)":

       
      ... og siden vi endrer Device Types, må vi huske å vise alle etter på:

       
       
      Den nye versjonen støtter altså flere lenker på samme script, man slipper å lage kopier av scriptet hvis man har flere lenker.  
    • Av Moskus
      Sub Main(ByVal parameters As Object) 'Moskus 2020 Dim devID As Integer = parameters.ToString Dim useHTMLtable As Boolean = True Dim url As String = "https://www.vg.no/spesial/2020/corona-viruset/data/norway-table-overview/" Dim source As String = "" Try Using client = New System.Net.WebClient Net.ServicePointManager.SecurityProtocol = Net.SecurityProtocolType.Tls12 client.Encoding = System.Text.Encoding.UTF8 source = client.DownloadString(url) End Using Catch ex As Exception hs.WriteLog("CoronaScript", "Net Feil: " & ex.Message) End Try If source = "" Then hs.WriteLog("CoronaScript", "Got no response from url: " & url) Exit Sub End If Dim json = Newtonsoft.Json.JsonConvert.DeserializeObject(Of Object)(source) Dim output As String = "" Try Dim confirmed As Integer = json("totals")("confirmed") If useHTMLtable Then output &= "<table border=0 cellspacing=0 cellpadding=0>" output &= "<tr><td><b>Totalt</b></td><td align='right'>" & json("totals")("confirmed") & "</td><td align='right'>" & json("totals")("dead") & "</td><td align='right'>" & json("totals")("recovered") & "</td></tr>" For i As Integer = 0 To json("cases").Count - 1 output &= "<tr><td>" & json("cases")(i)("name") & "</td><td align='right'>" & json("cases")(i)("confirmed") & "</td><td align='right'>" & json("cases")(i)("dead") & "</td><td align='right'>" & json("cases")(i)("recovered") & "</td></tr>" Next output &= "</table>" Else output &= "<b>Totalt: " & json("totals")("confirmed") & " / " & json("totals")("dead") & " / " & json("totals")("recovered") & "</b><br>" For i As Integer = 0 To json("cases").Count - 1 output &= "• " & json("cases")(i)("name") & ": " & json("cases")(i)("confirmed") & " / " & json("cases")(i)("dead") & " / " & json("cases")(i)("recovered") & "<br>" Next End If hs.SetDeviceString(devID, output, False) hs.SetDeviceValueByRef(devID, confirmed, True) Catch ex As Exception hs.WriteLog("CoronaScript", "Net Feil: " & ex.Message) End Try End Sub  
      Trigger: Kjøres hvert 5. minutt
      Parameter: DeviceIDen til en virtuell device som skal holde verdien.
      Du kan endre variabelen "useHTMLtable" til False hvis du vil ha det i HStouch, for HStouch viser ikke pene HTML-tabeller...
       

       
       
       
      Oppdatert med data fra RapidAPI siden jeg ble lei av at VG er så dårlig på å oppdatere tallene sine:
      Sub Main(ByVal parameters As Object) 'Moskus 2020 Dim devID As Integer = parameters.ToString Dim url As String = "https://covid-193.p.rapidapi.com/statistics?country=Norway" Dim source As String = "" Try Using client = New System.Net.WebClient 'TLS1.2 and encoding (UTF8) Net.ServicePointManager.SecurityProtocol = Net.SecurityProtocolType.Tls12 client.Encoding = System.Text.Encoding.UTF8 'Headers client.Headers.Set("x-rapidapi-host", "covid-193.p.rapidapi.com") client.Headers.Set("x-rapidapi-key", "DIN_RAPIDAPI_KEY_HER") 'GET the url source = client.DownloadString(url) End Using Catch ex As Exception hs.WriteLog("CoronaScript", "Net Feil: " & ex.Message) End Try If source = "" Then hs.WriteLog("CoronaScript", "Got no response from url: " & url) Exit Sub End If Try Dim json = Newtonsoft.Json.JsonConvert.DeserializeObject(Of Object)(source) Dim confirmed As Integer = json("response")(0)("cases")("total") Dim output As String = "" output &= "<b>Aktive: " & json("response")(0)("cases")("active") & " (" & json("response")(0)("cases")("new") & ") " & "</b><br>" output &= "Totalt: " & json("response")(0)("cases")("total") & "<br>" output &= "Dødsfall: " & json("response")(0)("deaths")("total") & " (" & IIf(json("response")(0)("deaths")("new").ToString = "", "0", json("response")(0)("deaths")("new")) & ") " & "<br>" output &= "Testede: " & json("response")(0)("tests")("total") & "<br>" output &= "<i>Sist oppdatert: " & json("response")(0)("time") & "</i><br>" hs.SetDeviceString(devID, output, False) hs.SetDeviceValueByRef(devID, confirmed, True) Catch ex As Exception hs.WriteLog("CoronaScript Error", "Parsefeil: " & ex.Message) End Try End Sub  
      Kjøres nå hver time, jeg vet ikke begrensningene hos RapidAPI.

       
       
    • Av Moskus
      Public Sub Main(ByVal input As Object) 'Moskus 2020 Dim device As Scheduler.Classes.DeviceClass Dim DE As Scheduler.Classes.clsDeviceEnumeration Dim counter As Integer = 0 Dim counterBelow100 As Integer Dim filter As String = "batter" 'tar da både "battery" og "batteri" hs.WriteLog("Battery", "Looking for battery devices...") DE = hs.GetDeviceEnumerator() Do While Not DE.Finished device = DE.GetNext If device.Device_Type_String(hs).ToLower.Contains(filter) OrElse device.DeviceType_Get(hs).Device_Type_Description.ToLower.Contains(filter) OrElse device.Name(hs).Contains(filter) Then Dim devName As String = device.Location2(hs) & ", " & device.Location(hs) & ", " & device.Name(hs) Dim devValue As Double = hs.DeviceValueEx(device.Ref(hs)) If devValue < 100 Then hs.WriteLog("Battery", "Device: " & devName & ", battery: " & devValue) counterBelow100 += 1 End If counter += 1 End If Loop hs.WriteLog("Battery", "Done! Found " & counter & " devices, " & counterBelow100 & " have levels below 100%.") End Sub  
      Bare lagre som "GetBatteryLevels.vb" og kjør det. Det skrives til loggen.
×
×
  • Opprett ny...