So, since the audience is primary native Dutch speaking i will continue further in Dutch.
Als je net als ik ook gebruik moet maken van de NS wil je niet eerst een half uur reizen naar het station om daar er achter te komen dat er weereens een vertraging is. Vandaar dit script dat loopt met een recurring event en in de ochtend via de speaker in de badkamer me even informeer dat ik vandaag me niet hoeft te haasten.
Dus wat is het. Het is een script die de NS storingen pagina in de gaten houdt of een van de door jou opgegeven plaatsen voorkomt in de lijst van storingen. Is dit het geval dan wordt een device ON
- Simpel weergave optie. Alleen aantal storingen.
- Mogelijkheid om trajecten op te geven
- Slechts 1 nieuw device.
- Device wordt gemaakt als deze niet aanwezig is.
- Device value, status en devicestring worden gezet voor gebruik in event triggers
- Kan een onderdeel zijn van je Verkeer monitoring set
- Uitgebreidde melding optie. Inclusief:
- Oorzaak
- Verwachtin met eventueel vertragingtijd
- Reisadvies
Overige informatie is in de header van het script.
Veel plezier.
- voorbeeld
- verkeer.png (78.56 KiB) Viewed 6087 times
Versie 1.1
Bij een hit werden ook alle meldingen getoond van routes die niet opgegeven waren. Dit is in deze versie opgelost. Ook meldingen die in het reis advies stonden zoals omleidingen via een van de opgegeven plaatsen werden getoond. Dit is nu niet meer het geval.
Code: Select all
' AZ_NS_storingen.vb
' Version : 1.1
' By A.A. van Zoelen
'
'Usage:
'
'AZ_NS_storingen("Main","<DeviceCode> ; <Detail Level>")
'Example : 'AZ_NS_storingen("Main","W39;N")
'
' Detail level - If N then just basic info is written in the
' device string. Otherwise Y will show detailed info.
'
' Remark : Search text is not case sensitive
' History
' v1.1
' Altered search methode to reduce false hits or showing
' to much (irrelevant) data.
'
' v1.0
' 16-01-2012 : First release
'===================================================================
Imports System.Net
Imports System.IO
Public Sub Main(ByVal Params As Object)
'*********************************************
' These variable must be set first
'*********************************************
Dim arrStation(20) As String
' This is an example of a trip from
' ** Roosendaal to Den Haag HS **.
' Because there can be an accident along every
' point on this traject i would like to know if
' there is something like 'signal failure between
' Delft and Rijswijk' along the whole traject.
' Using only the start and endpoints would not
' give you this information.
' Sadly this information can't be read reliable
' via a script so must be added by hand.(only once)
' Go to the NS site setup your traject and make
' sure you select then traject in the results
' that uses the all arrStations train (stoptrein).
' Then select the option 'Show tussenarrStations'
' These arrStations are all passed along your
' traject and can be entered below.
arrStation( 0) = "Roosendaal"
arrStation( 1) = "Oudenbosch"
arrStation( 2) = "Zevenbergen"
arrStation( 3) = "Lage Zwaluwe"
arrStation( 4) = "Dordrecht Zuid"
arrStation( 5) = "Dordrecht"
arrStation( 6) = "Zwijndrecht"
arrStation( 7) = "Barendrecht"
arrStation( 8) = "Rotterdam Lombardijen"
arrStation( 9) = "Rotterdam Zuid"
arrStation(10) = "Rotterdam Blaak"
arrStation(11) = "Rotterdam Centraal"
arrStation(12) = "Rotterdam Centrum"
arrStation(13) = "Delft Zuid"
arrStation(14) = "Delft"
arrStation(15) = "Rijswijk"
arrStation(16) = "Den Haag Moerwijk"
arrStation(17) = "Den Haag HS"
arrStation(18) = ""
arrStation(19) = ""
'*********************************************
' 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 strDeviceRoom As String = "Verkeer - Monitoring"
Dim strDeviceType As String = "Verkeer Monitoring"
Dim strDeviceFloor As String = "Systeem"
Dim URL = "http://www.ns.nl/storingen/index.form"
'************************************************
'************************************************
'Below this there is no real need for altering anything
'********************************
'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)
'********************************
'Get the detail level
'********************************
Dim blDetailedInfo As Boolean = hs.StringItem(Params, 2, ";") = "Y"
'********************************
'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_NS_Info</b>", "<b>Ongeldige DeviceCode!</b>")
Exit Sub
End If
If not (strHouseCode <> "") Then
hs.WriteLog("<b>AZ_NS_Info</b>", "<b>Ongeldige HouseCode!</b>")
Exit Sub
End If
'********************************
'Is the device available?
'********************************
If hs.DeviceExistsRef(strHouseCode & strDeviceCode) = -1 Then
Dim dv As Object
dv = hs.GetDeviceByRef(hs.NewDeviceRef("NS Storingen"))
dv.hc = strHouseCode
dv.dc = strDeviceCode
dv.misc = "&h10"
dv.location = strDeviceRoom
dv.location2 = strDeviceFloor
dv.dev_type_string = strDeviceType
End If
'**********************************
' We are ready to get the html page
'**********************************
Dim strWebPage As String
Try
strWebPage = getHtml(URL)
Catch ex As Exception
hs.writelog("<b>AZ_NS_Info</b>","<b>Connection to site failed due:" & ex.Message & "</b>")
Exit Sub
End Try
'**********************************
' Next we need to grab all the
' index blocks. The index blocks
' all start with a #Prio block
' vb. <a href="#prio-25071">
'**********************************
Dim blnFound As Boolean
Dim strDetails As String
Dim strTemp As String
Dim strPrioNumber As String
Dim intStart As Integer
Dim intEnd As Integer
Dim intDisruptions As Integer
Do
' Find then # sign
intStart = Instr(strWebPage, "#prio") + 1
' Remove everything till this sign
strTemp = Right(strWebPage, Len(strWebPage) - intStart)
' Next find the end op the prio value
intEnd = Instr(strTemp, ">") - 1
strPrioNumber = Left(strTemp, intEnd)
' We have saved the number of the disruption
' for further processing if detailed
' information is requested.
' The next <span> block contains the location
' of the disruption so grab it now.
strTemp = Left(strTemp, Instr(strTemp, "</span>") )
' See if the <span> block contains
' any of the given stations
blnFound = CompareStations(strTemp, arrStation)
If (blnFound = True) Then
intDisruptions = intDisruptions + 1
' Do we need to get detailed info?
If (blDetailedInfo = True) then
strDetails = strDetails & GetDetails(strPrioNumber, strWebPage)
End If
End If
' Remove the index block that is just parsed
strTemp = Right(strWebPage, Len(strWebPage) - intStart)
strWebPage = Right(strTemp, Len(strTemp) - intEnd)
Loop until Instr(strWebPage, "#prio") = 0
'**************************************
' All the index blocks has been checked
' so its time to display things
' But first clean up html if details
' need to be displayed.
'**************************************
If (Len(strDetails ) > 0) Then strDetails = CleanDetails(strDetails)
'**************************************
' Now its about time to send the
' information to the device
'**************************************
if(intDisruptions = 0) then
NoActions(strDevice)
Else
DoActions(strDevice, strDetails, intDisruptions)
End If
End Sub
'********************************
'********************************
'A dditional 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
'********************************
' Compare the list of stations
' with the index block.
'********************************
Function CompareStations(ByVal strTemp As String, ByVal arrStation() As string) As Boolean
Dim Count As Integer
For Count = 0 to UBound(arrStation)
If arrStation(count) <> "" Then
If (Instr(strTemp, arrStation(Count)) ) > 0 Then Return True
End If
Next
Return False
End Function
'********************************
' The user wants detailed info
' related to this prio number.
'********************************
Function GetDetails(ByVal strPrioNumber As String, ByVal strWebPage As String) As String
Dim strTemp As String
' Detailed info can be found in a
' section called class="briefing rounded"
' So get there first.
strTemp = Right(strWebPage, Len(strWebPage) - Instr(strWebPage , "briefing rounded") )
' Search from here for the prio number
strTemp = Right(strTemp, Len(strTemp) - Instr(strTemp, strPrioNumber) )
' We have reached the relevant block
' Go to the start of the html
' we want to grab
strTemp = Right(strTemp, Len(strTemp) - Instr(strTemp, "<h2>") + 1 )
' The end of the block is
' marked with a </ul>
' Grab it including the </ul>
strTemp = Left(strTemp, Instr(strTemp, "</ul>") + Len("</ul>") )
Return strTemp
End Function
'********************************
' Remove and transform HTML
'********************************
Function CleanDetails(strDetails) As String
'Now do some html mark up to remove
'the big letters caused by <H2> and <H3>
strDetails = Replace(strDetails, "<br>", "</b><br>")
strDetails = Replace(strDetails, "</ul>", "</i></ul>")
strDetails = Replace(strDetails, "</h2>", "")
strDetails = Replace(strDetails, "<h3>Oorzaak</h3>", "<br><b>Oorzaak</b><br>")
strDetails = Replace(strDetails, "<h3>Verwachting</h3>", "<br><b>Verwachting</b><br>")
strDetails = Replace(strDetails, "<h3>Reisadvies</h3>", "<br><b>Reisadvies</b><br>")
strDetails = Replace(strDetails, "<ul>", "<ul><i>")
strDetails = Replace(strDetails, "<h2>", "<b>")
Return strDetails
End Function
'********************************
' There are disruptions found.
'********************************
Sub DoActions(strDevice as String, strDetails As String, intDisruptions as Integer)
If (Len(strDetails) > 0 ) Then
hs.setdevicestring(strDevice, strDetails )
Else
If (intDisruptions = 1) Then
hs.setdevicestring(strDevice, intDisruptions & " Storing gevonden")
Else
hs.setdevicestring(strDevice, intDisruptions & " Storingen gevonden")
End If
End If
hs.setdevicevalue(strDevice,100)
hs.setdeviceStatus(strDevice,2) 'ON
hs.setdevicelastchange(strDevice,now)
End Sub
'********************************
' There are no disruptions found.
'********************************
Sub NoActions(strDevice as String)
hs.setdevicestring(strDevice,"Geen storingen gevonden")
hs.setdevicevalue(strDevice,0)
hs.setdeviceStatus(strDevice, 3) 'OFF
hs.setdevicelastchange(strDevice,now)
End Sub
