Gjorde noen endringer for å få det til å virke som jeg ønsket 😃
Legger koden ut her, om det andre som ser nytten i den 😃
'Enable or disable debug logging
Const DEBUG_LOGGING_ENABLED As Boolean = False
Sub Main(ByVal parameters As Object)
'Clio75 All Credits to
[email protected]
'Inspired and based on Moskus scrip NewsReader.vb
'Parse parameters
Dim DevID As Integer = parameters.ToString.Split("|")(0)
Dim KommuneNr As String = parameters.ToString.Split("|")(1)
Dim Gatekode As String = parameters.ToString.Split("|")(2)
Dim GateNavn As String = parameters.ToString.Split("|")(3)
Dim GateNr As String = parameters.ToString.Split("|")(4)
'Base URLs and Headers
Dim baseURL As String = "https://norkartrenovasjon.azurewebsites.net/proxyserver.ashx?server="
Dim tommekalenderURL As String = baseURL & "https://komteksky.norkart.no/MinRenovasjon.Api/api/tommekalender/?kommunenr=" & KommuneNr & "&gatenavn=" & GateNavn & "&gatekode=" & Gatekode & "&husnr=" & GateNr
Dim fraksjonerURL As String = baseURL & "https://komteksky.norkart.no/MinRenovasjon.Api/api/fraksjoner/"
Dim appKey As String = "AE13DEEC-804F-4615-A74E-B4FAC11F0A30"
Dim iconFolder As String = "html\images\renovasjon\"
'Ensure icon folder exists
If Not IO.Directory.Exists(iconFolder) Then
IO.Directory.CreateDirectory(iconFolder)
End If
WriteDebugLog(DEBUG_LOGGING_ENABLED, "Starting script execution with parameters: " & parameters.ToString())
'Fetch fraksjoner data
Dim fraksjoner As Object = GetJsonResponse(fraksjonerURL, KommuneNr, appKey)
If fraksjoner Is Nothing Then
hs.WriteLog("Soppel Error", "Failed to fetch fraksjoner data.")
Exit Sub
End If
WriteDebugLog(DEBUG_LOGGING_ENABLED, "Fetched fraksjoner data.")
'Fetch tommekalender data
Dim tommekalender As Object = GetJsonResponse(tommekalenderURL, KommuneNr, appKey)
If tommekalender Is Nothing Then
hs.WriteLog("Soppel Error", "Failed to fetch tommekalender data.")
Exit Sub
End If
WriteDebugLog(DEBUG_LOGGING_ENABLED, "Fetched tommekalender data.")
'Look up the parent device by its reference (DevID)
Dim parentDevice As Scheduler.Classes.DeviceClass = hs.GetDeviceByRef(DevID)
If parentDevice Is Nothing Then
WriteDebugLog(DEBUG_LOGGING_ENABLED, "Parent device not found, exiting.")
Exit Sub
End If
'Declare childDevice outside the loop to reuse
Dim childDevice As Scheduler.Classes.DeviceClass = Nothing
Dim iconFilePath As String = ""
'Process each item in tommekalender
For Each calendarItem As Object In tommekalender
Try
Dim fraksjonId As Integer = calendarItem("FraksjonId")
Dim tommedatoer As Object = calendarItem("Tommedatoer")
Dim fraksjonName As String = GetFraksjonName(fraksjoner, fraksjonId)
Dim fraksjonIcon As String = GetFraksjonIcon(fraksjoner, fraksjonId)
WriteDebugLog(DEBUG_LOGGING_ENABLED, "Processing item: FraksjonId=" & fraksjonId & ", Name=" & fraksjonName)
'Look for an existing child device under the parent device
Dim childDeviceExists As Boolean = False
Dim deviceRef As Integer = -1
For Each associatedDeviceRef As Integer In parentDevice.AssociatedDevices(hs)
Dim device As Scheduler.Classes.DeviceClass = hs.GetDeviceByRef(associatedDeviceRef)
If device IsNot Nothing AndAlso device.Name(hs) = fraksjonName Then
childDeviceExists = True
deviceRef = device.Ref(hs)
Exit For
End If
Next
'If the device does not exist, create a new device
If Not childDeviceExists Then
WriteDebugLog(DEBUG_LOGGING_ENABLED, "Creating new child device for " & fraksjonName)
deviceRef = hs.NewDeviceRef(fraksjonName)
childDevice = hs.GetDeviceByRef(deviceRef)
If childDevice IsNot Nothing Then
childDevice.Device_Type_String(hs) = "Renovasjon Fraksjon"
childDevice.Interface(hs) = "Renovasjon"
childDevice.Name(hs) = fraksjonName
childDevice.Location(hs) = parentDevice.Location(hs)
childDevice.Location2(hs) = parentDevice.Location2(hs)
childDevice.Relationship(hs) = HomeSeerAPI.Enums.eRelationship.Child
parentDevice.AssociatedDevice_Add(hs, deviceRef)
hs.SaveEventsDevices()
End If
Else
childDevice = hs.GetDeviceByRef(deviceRef)
End If
'Update device properties
If childDevice IsNot Nothing Then
If tommedatoer.Count > 0 Then
Dim firstDate As DateTime = DateTime.Parse(tommedatoer(0))
'hs.SetDeviceString(deviceRef, "2024-12-31", True) 'hardcode date test
hs.SetDeviceString(deviceRef, firstDate.ToString("yyyy-MM-dd"), True)
hs.SetDeviceValue(deviceRef, 0)
End If
'Download and set the icon if needed
If fraksjonIcon <> "" Then
iconFilePath = iconFolder & fraksjonId & ".png"
If Not IO.File.Exists(iconFilePath) Then
Try
Dim client As New System.Net.WebClient
client.DownloadFile(fraksjonIcon, iconFilePath)
Catch ex As Exception
hs.WriteLog("Soppel Error", "Failed to download icon: " & ex.Message)
End Try
End If
If IO.File.Exists(iconFilePath) Then
Dim pair As New HomeSeerAPI.VSVGPairs.VGPair With {
.Graphic = "images/renovasjon/" & fraksjonId & ".png",
.Set_Value = 0,
.PairType = HomeSeerAPI.VSVGPairType.SingleValue
}
hs.DeviceVGP_AddPair(deviceRef, pair)
End If
End If
End If
Catch ex As Exception
WriteDebugLog(DEBUG_LOGGING_ENABLED, "Error processing item: " & ex.Message)
End Try
Next
WriteDebugLog(DEBUG_LOGGING_ENABLED, "Script execution completed.")
End Sub
Function GetJsonResponse(ByVal url As String, ByVal kommuneNr As String, ByVal appKey As String) As Object
Dim client As New System.Net.WebClient
client.Headers.Add("Kommunenr", kommuneNr)
client.Headers.Add("RenovasjonAppKey", appKey)
client.Encoding = System.Text.Encoding.UTF8
'Log before attempting to fetch the data
WriteDebugLog(DEBUG_LOGGING_ENABLED, "Fetching JSON from URL: " & url)
Try
Dim response As String = client.DownloadString(url)
' Log the response before deserialization
WriteDebugLog(DEBUG_LOGGING_ENABLED, "Response: " & response)
Return Newtonsoft.Json.JsonConvert.DeserializeObject(response)
Catch ex As Exception
' Log the error message
WriteDebugLog(DEBUG_LOGGING_ENABLED, "Error fetching URL: " & ex.Message)
Return Nothing
End Try
End Function
Function GetFraksjonName(ByVal fraksjoner As Object, ByVal fraksjonId As Integer) As String
If fraksjoner Is Nothing Then
WriteDebugLog(DEBUG_LOGGING_ENABLED, "fraksjoner is Nothing")
Return "Unknown"
End If
WriteDebugLog(DEBUG_LOGGING_ENABLED, "Searching for fraksjon with ID: " & fraksjonId)
For Each fraksjon As Object In fraksjoner
WriteDebugLog(DEBUG_LOGGING_ENABLED, "Checking fraksjon ID: " & fraksjon("Id"))
If fraksjon("Id") = fraksjonId Then
WriteDebugLog(DEBUG_LOGGING_ENABLED, "Found fraksjon: " & fraksjon("Navn"))
Return fraksjon("Navn").ToString()
End If
Next
WriteDebugLog(True, "No matching fraksjon found.")
Return "Unknown"
End Function
Function GetFraksjonIcon(ByVal fraksjoner As Object, ByVal fraksjonId As Integer) As String
If fraksjoner Is Nothing Then
WriteDebugLog(DEBUG_LOGGING_ENABLED, "fraksjoner is Nothing")
Return ""
End If
WriteDebugLog(DEBUG_LOGGING_ENABLED, "Searching for icon for fraksjon ID: " & fraksjonId)
For Each fraksjon As Object In fraksjoner
WriteDebugLog(DEBUG_LOGGING_ENABLED, "Checking fraksjon ID: " & fraksjon("Id"))
If fraksjon("Id") = fraksjonId Then
WriteDebugLog(DEBUG_LOGGING_ENABLED, "Found icon: " & fraksjon("NorkartStandardFraksjonIkon"))
Return fraksjon("NorkartStandardFraksjonIkon").ToString()
End If
Next
WriteDebugLog(DEBUG_LOGGING_ENABLED, "No matching icon found.")
Return ""
End Function
'Function to log debug messages to a file
Sub WriteDebugLog(ByVal enabled As Boolean, ByVal message As String)
If Not enabled Then Exit Sub
Dim logFilePath As String = "C:\Program Files (x86)\HomeSeer HS4\Logs\renovasjon_debug.txt"
Try
Dim logMessage As String = DateTime.Now.ToString("yyyy-MM-dd HH:mm:ss") & " - " & message & vbCrLf
System.IO.File.AppendAllText(logFilePath, logMessage)
Catch ex As Exception
hs.WriteLog("Soppel Error", "Failed to write to log file: " & ex.Message)
End Try
End Sub
Denne versjonen laster ned fraksjonene og bilder fra apiet og oppretter en sub device pr. fraksjon.
Det blir da seende ut slik:
Konfigureres slik som @clio75 har beskrevet 😃
