Hier is weer een scriptje in de categorie 'leuk als je het kan gebruiken!'
Met dit scriptje kan je de berichten die via het P2000 systeem worden verzonden opnemen in je systeem. Via het P2000 systeem worden oproepen geregistreert en doorgezet naar de polite, brandweer en ambulances. Hiermee kan je dus op de hoogte blijven wat er zoal bij je in de buurt gebeurd.
Het script set ook de device value op 1 zodat je hiermee ook een event kan laten afgaan zoals een omroep van het bericht.
Het script heeft weer de gebruikelijke opzet en volop gecommentariseerd zodat je kan volgen wat er gebeurd
UPDATE v1.2
Op verzoek de mogelijkheid ingebouwd om de laatste X berichten te tonen.
Op deze laatste berichten is ook het filter van toepassing als deze is ingevuld.
Let op
Als je upgrade naar versie gebruikt dan zal het device wat je gebruikt een volgnummer krijgen.
Het makkelijkste is om gewoon alle oude device weg te doen. Deze worden opnieuw aangemaakt door het script.
Mocht je een event hebben dat afgaat op een vorig device dan moet je deze even checken op deze nog naar het juiste device wijst. De kans is groot dat dit aangepast moet worden.
UPDATE v1.1
Als je in een grote plaats woont dan kunnen er wel veel berichten binnenkomen die aan de andere kant van de stad gebeuren en waar je geen intresse in hebt. Of je wilt alleen maar berichten hebben uit je eigen postcode regio of zelfs alleen je straat. Dan kan dit nu doordat er een extra filter is toegevoegd.
Code: Select all
' AZ_P2000.vb
' Version : 1.2
' By A.A. van Zoelen
'
'Usage:
'
'AZ_P2000("Main","<DeviceCode>;<number of messages>")
'Example : 'AZ_P2000("Main","W37;5")
'
'
'USAGE with HomeSeer
'Make an event and select script.
'For the parameter field use ("Main","W37;5")
'
'where: ("Main","<DeviceCode>,<Number of messages> ")
'(Note: Main with a capital M)
' <DeviceCode> vb.W37 - is the device code to use as first device
' <Number of messages> vb. 5
' In this case the top 5 messages are fetched and
' shown in 5 device strings.
' If you ommit this parameter then only 1 device
' will be created.
'
' Remark : P2000 is the Dutch registration and notification system
' used by the police, ambulance and firefighters.
' The script will fetch the top X entries.
'
' History
' v1.2
' Added multi messages support
'
' v1.1
' 25-08-2012
' Added extra filter to make the monitor area smaller
' This is specially nice for cities.
'
' v1.0
' 23-08-2012 : First release
'===================================================================
Imports System.Net
Imports System.IO
Public Sub Main(ByVal Params As Object)
'*********************************************
' These variable must be set first
'*********************************************
Dim Debug as boolean
Debug = false
'*********************************************
' The next few variables might be alter if needed
' Use these values to create new device(s)
' If you also use the traffic jam script then
' this is a good moment to name then the same.
Dim strDeviceFloor As String = "Systeem" ' Used in colomn FLOOR
Dim strDeviceRoom As String = "Monitoring" ' Used in column ROOM
Dim strDeviceType As String = "P2000 Monitoring" ' Device type
Dim strLogID As String = "P2000" ' Indentifer used in logfile
' Go to http://politiescanner.net
' On the top of the screen select your place and regio
' Press ZOEK
' If you are happy with the results then copy the URL
' and paste it below
Dim URL = "http://politiescanner.net/Default.aspx?w=zoekresultaat&q=breda&r=Midden-%20en%20West-Brabant"
' For cities there can be to many search results
' To put an extra filter on this you can fill in
' the variable below. The result will only be shown
' if this filter apply so be careful what you enter there.
' eg. 1024 Search for postcode area
' 1024X A more smaller area
' Streetname
Dim strFilter As String = ""
'************************************************
'************************************************
'Below this there is no real need for altering
'anything unless you know what you are doing.
'Make the filter uppercase
strFilter = UCase(strFilter)
'********************************
'Get the device code
'********************************
Dim strDevice As String = hs.StringItem(Params, 1, ";")
Dim strHouseCode As String = GetChar(strDevice,1)
Dim strDeviceCode As String = strDevice.subString(1)
If Debug = true then hs.WriteLog("<b>AZ_" & strLogID & "_Info</b>", "Checking devicecode")
'********************************
'Get the number of messages
'********************************
Dim intNumberOfMessages as Integer = 1
intNumberOfMessages = Val( hs.StringItem(Params, 2, ";") )
If intNumberOfMessages < 1 Then intNumberOfMessages = 1
If Debug = true then hs.WriteLog("<b>AZ_" & strLogID & "_Info</b>", "Checking for " & intNumberOfMessages & " messages max.")
'********************************
'First do some checks
'Is the device and house code oke
'********************************
If not ((Val(strDeviceCode)>=1) And (Val(strDeviceCode)<=128)) Then
hs.WriteLog("<b>AZ_" & strLogID & "_Info</b>", "<b>Ongeldige DeviceCode!</b>")
Exit Sub
End If
If Debug = true then hs.WriteLog("<b>AZ_" & strLogID & "_Info</b>", "Checking houcecode")
If not (strHouseCode <> "") Then
hs.WriteLog("<b>AZ_" & strLogID & "</b>", "<b>Ongeldige HouseCode!</b>")
Exit Sub
End If
If Debug = true then hs.WriteLog("<b>AZ_" & strLogID & "_Info</b>", "Is device available?")
'********************************
'Are the devices(s) available
'********************************
Dim i As Integer
For i = 0 To intNumberOfMessages - 1
If Debug = true then hs.WriteLog("<b>AZ_" & strLogID & "_Info</b>", "Is device " & i & " available?")
If hs.DeviceExistsRef(strHouseCode & Val(strDeviceCode)+i) = -1 Then
Dim dv As Object
dv = hs.GetDeviceByRef(hs.NewDeviceRef("P2000 message " & i + 1))
dv.hc = strHouseCode
dv.dc = Val(strDeviceCode) + i
dv.misc = "&h10"
dv.location = strDeviceRoom
dv.location2 = strDeviceFloor
dv.dev_type_string = strDeviceType
End If
Next
If Debug = true then hs.WriteLog("<b>AZ_" & strLogID & "_Info</b>", "Device is (now) available")
'**********************************
' We are ready to get the html page
'**********************************
Dim strWebPage As String
Try
strWebPage = getHtml(URL)
Catch ex As Exception
hs.setdevicestring(strDevice, URL + " onbereikbaar")
hs.setdevicevalue(strDevice, 0)
hs.setdevicelastchange(strDevice, now)
hs.writelog("<b>AZ_" & strLogID & "</b>","<b>Connection to site failed due:" & ex.Message & "</b>")
Exit Sub
End Try
If Debug = true then hs.WriteLog("<b>AZ_" & strLogID & "_Info</b>", "I was able to grab the webpage")
'**********************************
' Check if the page is available.
'**********************************
if Len(strWebPage) < 100 then
hs.writelog("<b>AZ_" & strLogID & "</b>","<b>" + URL + " returned to few bytes</b>")
hs.setdevicestring(strDevice, URL + "onbereikbaar")
hs.setdevicevalue(strDevice, 0)
hs.setdevicelastchange(strDevice, now)
Exit Sub
End If
If Debug = true then hs.WriteLog("<b>AZ_" & strLogID & "_Info</b>", "Processing web page")
'**********************************
' Next we need to grab all the
' the info from the collected data
'**********************************
Dim intStart As Integer
Dim intEnd As Integer
Dim strTemp As String
' Goto the start of the details
' The page make use of alternating background coloring
' and the source code show a remark block first.
' Make sure that you pass this block if it's there.
intStart = Instr(strWebPage, "--><tr>")
strWebPage = Right(strWebPage, Len(strWebPage) - intStart)
' We are are the start of the messages block
' Get the message(s) and process this.
i = 0
While i < intNumberOfMessages
' Get the first message (if available)
intStart = Instr(strWebPage, "prio BLT") + Len("prio BLT")
strWebPage = Right(strWebPage, Len(strWebPage) - intStart)
strTemp = ""
' Check if there are more messages left
If intStart > 0 Then
If Debug = true then hs.WriteLog("<b>AZ_" & strLogID & "_Info</b>", "Found an message")
strTemp = FindNextMessage(strWebPage, strFilter)
End If
'Remove the message from the message block
' intStart = Instr(strWebPage, "prio BLT") + Len("prio BLT")
' strWebPage = Right(strWebPage, Len(strWebPage) - intStart)
If Debug = true then hs.WriteLog("<b>AZ_" & strLogID & "_Info</b>", "Size message block is: " & Len(strWebPage))
If Debug = true then hs.WriteLog("<b>AZ_" & strLogID & "_Info</b>", "Grabbed detail: " & strTemp)
If Debug = true then hs.WriteLog("<b>AZ_" & strLogID & "_Info</b>", "Device detail: " & hs.devicestring(strHouseCode & Val(strDeviceCode + i)))
' Do nothing if the message is empty
If strTemp <> "" Then
If strTemp <> hs.devicestring(strHouseCode & Val(strDeviceCode + i)) Then
If Debug = true then hs.WriteLog("<b>AZ_" & strLogID & "_Info</b>", "Grabbed detail is different then device string")
' I set the value to 1 so it can trigger an event
' just in case you need it. In the event you can
' set the value back to zero in the event if you want.
hs.SetDeviceString(strHouseCode & Val(strDeviceCode + i), strTemp, true)
hs.SetDeviceValue(strHouseCode & Val(strDeviceCode + i), 1)
hs.setdevicelastchange(strHouseCode & Val(strDeviceCode + i), now)
Else
If Debug = true then hs.WriteLog("<b>AZ_" & strLogID & "_Info</b>", "Grabbed detail is equal to the device string")
End If
i = i + 1
Else
If Debug = true then hs.WriteLog("<b>AZ_" & strLogID & "_Info</b>", "Nothing found due to filtering.")
End If
If Instr(strWebPage, "prio BLT") = 0 Then
i = intNumberOfMessages
If Debug = true then hs.WriteLog("<b>AZ_" & strLogID & "_Info</b>", "No more messages found.")
End If
End While
End Sub
'********************************
'********************************
' Additional functions and such
'********************************
'********************************
' Get the HTML code of the requested web site
Function getHtml(ByVal url As String) As String
Dim myWebRequest As HttpWebRequest = DirectCast(HttpWebRequest.Create(url), HttpWebRequest)
myWebRequest.Method = "GET"
' make request for web page
Dim myWebResponse As HttpWebResponse = DirectCast(myWebRequest.GetResponse(), HttpWebResponse)
Dim myWebSource As New StreamReader(myWebResponse.GetResponseStream())
Dim myPageSource As String = String.Empty
myPageSource = myWebSource.ReadToEnd()
myWebResponse.Close()
return myPageSource
End Function
'********************************
' Get the next message from the page
' The function returns an empty string
' when the filter does not apply
Function FindNextMessage(Byval strWebpage as String, Byval strFilter As String) As String
Dim strTemp As String = String.Empty
Dim intStart As Integer
Dim intEnd As Integer
Dim strDatum As String
Dim strTijd As String
' First get the date and time of the incident
intStart = Instr(strWebPage, "BLT CENTER") + Len("BLT CENTER") + 1
strWebPage = Right(strWebPage, Len(strWebPage) - intStart)
' Get the time here
intEnd = Instr(strWebPage, "<div") - 1
strTijd = Left(strWebPage, intEnd)
' Goto the date
intStart = Instr(strWebPage, "KLEIN>") + Len("KLEIN>") - 1
strWebPage = Right(strWebPage, Len(strWebPage) - intStart)
' Get the date here
intEnd = Instr(strWebPage, "</div") - 1
strDatum = Left(strWebPage, intEnd)
' Now go to the actual start of the details
intStart = Instr(strWebPage, "BLTR") + Len("BLTR") + 1
strWebPage = Right(strWebPage, Len(strWebPage) - intStart)
' Find the end of this detail info
intEnd = Instr(strWebPage, "<div") - 1
' Parse the detailed information
strTemp = Left(strWebPage, intEnd)
' Do some tiddying up
strTemp = "Op " & strDatum & " om " & strTijd & " " & strTemp
If Instr(UCase(strTemp), strFilter) = 0 Then strTemp = ""
return strTemp
End Function
ik voldoe eraan bij deze!