Mogelijke opties
- Toon totaal aantal files.
- Files tonen in detail.
- Verschillende wegen ID in de gaten houden.
- Verschillende wegen per device.
- Meerdere wegen per device.
- Mogelijkheid to speech vb. In een event speak "File melding. $$DS:<DeviceCode>"
- Events zetten op de devices met files meldingen.
- Device value en status worden geupdate.
- HTML bestandjes per opgegeven weg genereren.
UPDATE:
De laatste versie is 1.4
Bug fix :
- Hersteld typefout
Bij de optie meerdere devices werd de waarde van het device niet aangepast
Code: Select all
'AZ_FileInfo.vb
'by A.A. van Zoelen
' Version
' 1.0 - 12 jan 2012 (first release)
' 1.1 - 18 jan 2012 Bug fix
' Count in string selection was occassionally negative.
' 1.2 - 25 apr 2012 Bug fix
' String handling improved
' New URL added
' 1.3 - Added option for HSTouch text object view
' Removed parsing bug
'1.4 - 4 Sept 2012 Bug fix
' Corrected a typo that prevented device value updates
'
'USAGE with HomeSeer
'Make an event and select script.
'For the parameter field use ("Main","W40;Y;N;A16 N11 A12 A13")
'
'where: ("Main","<DeviceCode>,<MultiDevices>,<DetailLevel>,<Route id(s)> ")
'Main with a capital M
' <DeviceCode> vb.W40 - is the device code to use as first device
' <MultiDevices> vb. Y - Y(es) or N(o)
' When N then file information is placed in just 1 device.
' When Y then for each road ID given there will be made
' a device holding the relevant information.
' Note: In this example 4 devices will be created
' starting from W40 and then W41, W42, W43
' <DetailLevel> vb. Y - Y(es) or N(o)
' When N only the file count on the road ID is shown
' When Y also the detailed info will be shown.
' <Road ID(s)> vb. A28 A12 N11
' A list with road id's that you want information from.
' Each road ID is seperated with a space from the other
' Leaving this empty will give you every file
'
'REMARKS
'I may be nessecary to throw away old devices when you
'update your road id list.
'
'This script is optimized for http://www.verkeerplaza.nl/filelijst
'And most likely won't work for an other source.
sub Main(byVal params As Object)
'*********************************************
' These variable must be set first
'*********************************************
'Write debug info to the HS log file.
'The logging is very intensive!
'true or false
Dim Debug as boolean
Debug = false
'If you have trouble displaying data in a text field
'on a HSTouch device then set this to true. For each
'road there will be a html file created in the given
'folder so you can include that as source for the
'text object in the HSTouch designer.
'Remark: Fill in the URL to this file in the
' property called Text.
Dim IsHsTouch as boolean
Dim InfoFolder as String
IsHsTouch = true
InfoFolder = "c:/Program Files/HomeSeer HSPRO/html/AZTools/"
'The full URL to the page where the data is
'USE FORWARD SLASHES AS IN //
Dim strURL as String
strURL = "http://www.verkeerplaza.nl/filelijst"
'*********************************************
' The next few variables might be alter if needed
'The tag for the Road list block
Dim strRoadListTag as String
strRoadListTag = "list-road"
Dim strRoadListEndTag as String
strRoadListEndTag = "</div>"
' Use these values to create new device(s)
Dim strDeviceRoom As String = "Monitoring"
Dim strDeviceType As String = "Verkeer Monitoring"
Dim strDeviceFloor As String = "Systeem"
'*********************************************
'Below this there is no real need for altering anything
Dim strSite as String
Dim strPath as String
Dim strWebPage as String
Dim intTemp as Integer
Dim strTemp as String
Dim strOutput as String
Dim intNumberOfRoads as Integer
Dim i as Integer
Dim count as Integer
Dim CalcLenght as Integer
Dim strRoads ' String array
Dim strDevice As String = hs.StringItem(Params, 1, ";")
Dim strHouseCode As String = GetChar(strDevice,1)
Dim strDeviceCode As String = strDevice.subString(1)
Dim blMultiDevices As Boolean = hs.StringItem(Params, 2, ";") = "Y"
Dim blDetailedInfo As Boolean = hs.StringItem(Params, 3, ";") = "Y"
Dim strRoadList as String = hs.StringItem(Params, 4, ";")
If Debug = true Then
hs.writelog("AZ_FileInfo","strDevice :" & strDevice & ":" )
hs.writelog("AZ_FileInfo","blMultiDevices :" & blMultiDevices.ToString & ":" )
hs.writelog("AZ_FileInfo","blDetailedInfo :" & blDetailedInfo.ToString & ":" )
hs.writelog("AZ_FileInfo","strRoadList :" & strRoadList & ":" )
End If
'********************************
' If there are roads then split
' them into an array
'********************************
strRoads = Split(strRoadList," ")
intNumberOfRoads = UBound(strRoads)
If Debug = true Then hs.writelog("AZ_FileInfo","Number of roads :" & intNumberOfRoads + 1)
'********************************
'First do some checks
'Is the device and house code oke
'********************************
If not ((Val(strDeviceCode)>=1) And (Val(strDeviceCode)<=128)) Then
hs.WriteLog("AZ_FileInfo", "Ongeldige DeviceCode!")
Exit Sub
End If
If not (strHouseCode <> "") Then
hs.WriteLog("AZ_FileInfo", "Ongeldige HouseCode!")
Exit Sub
End If
'********************************
'Are the devices(s) available
'********************************
If blMultiDevices Then
For i = 0 To intNumberOfRoads
If Debug = true Then hs.writelog("AZ_FileInfo","Road(" & i & ") = " & strRoads(i))
If hs.DeviceExistsRef(strHouseCode & Val(strDeviceCode)+i) = -1 Then
Dim dv As Object
dv = hs.GetDeviceByRef(hs.NewDeviceRef("File(s)" & " op " & strRoads(i)))
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
Else
If hs.DeviceExistsRef(strHouseCode & strDeviceCode) = -1 Then
Dim dv As Object
dv = hs.GetDeviceByRef(hs.NewDeviceRef("File(s)"))
dv.hc = strHouseCode
dv.dc = strDeviceCode
dv.misc = "&h10"
dv.location = strDeviceRoom
dv.location2 = strDeviceFloor
dv.dev_type_string = strDeviceType
End If
End If
'********************************
'Get Address and path of the URL
'********************************
strTemp = Replace(UCase(strURL), "HTTP://", "")
intTemp = Instr(strTemp, "/")
strSite = "http://" & Left(strTemp, intTemp - 1)
strPath = Right(strTemp, Len(strTemp) - intTemp + 1)
If Debug = true then
hs.writelog("AZ_FileInfo","Site found :" & strSite )
hs.writelog("AZ_FileInfo","Path found :" & strPath )
End If
'********************************
'Try to get the website data
'********************************
Try
strWebPage = hs.GetURL(strSite, strPath, false, 80)
If Len(strWebPage) < 100 Then
hs.SetDeviceString(strDevice, "Website " & strURL & " down", True)
hs.SetDeviceStatus(strDevice, 17)
hs.writelog ("AZ_FileInfo","No data found at " & strURL):exit sub
End If
Catch ex As Exception
hs.writelog("AZ_FileInfo","Connection to site failed due:" & ex.Message )
Exit Sub
End Try
If Debug = true Then hs.writelog("AZ_FileInfo","Byte(s) found :" & len(strWebPage) )
'********************************
'Now we have the complete webpage
'loaded into a string we can
'search for the road list block
'and drop all data infront
'and after the block.
'********************************
'Occassionally there is a negative string lenght which
'obviously isn't possible to caught this calculate the
'lenght first and make sure that it's => 0
CalcLenght = Len(strWebPage) - InStr(strWebPage, strRoadListTag) + 1
If CalcLenght < 0 Then CalcLenght = 0
strWebPage = "<ul class=" & Right(strWebPage, CalcLenght )
CalcLenght = InStr(strWebPage, strRoadListEndTag ) - 1
If CalcLenght < 0 Then CalcLenght = 0
strWebPage = Left(strWebPage, CalcLenght)
'********************************
'We have the data block.
'If the user wants this be split
'to seperate roads then do it
'here otherwise place all file
'information into one device.
'********************************
If blMultiDevices Then
'-----------------------
'Multiple devices
'-----------------------
i = 0
Do
If intNumberOfRoads > 0 Then
strTemp = FindRoadNumberBlock(strWebPage, strRoads(i), Debug)
Else
strTemp = strWebPage
End If
count = CountOccurrences(strTemp, "locatie" , false, Debug)
If strRoads(i) <> "" Then
strOutput = strRoads(i)
Else
strOutput = "Geheel NL"
End If
strOutput = strOutput & " - Totaal " & count & " files" & vbCrLf
If blDetailedInfo then strOutput = strOutput & strTemp
If IsHsTouch = true Then WriteRoadToFile(strOutput, InfoFolder, debug)
hs.SetDeviceString(strHouseCode & Val(strDeviceCode + i), strOutput, true)
hs.SetDeviceValue(strHouseCode & Val(strDeviceCode + i), count)
If Debug = true Then hs.writelog("AZ_FileInfo","Number of traffic jams(s) on " & strRoads(i) & ":" & count )
i = i + 1
Loop until i > intNumberOfRoads
Else
'-----------------------
'One device to hold all
'-----------------------
i = CountOccurrences(strWebPage, "locatie" , false, Debug)
hs.SetDeviceValue(strHouseCode & Val(strDeviceCode), i)
strOutput = "Geheel NL - Totaal " & i & " files"
If blDetailedInfo then strOutput = strOutput & strWebPage
If IsHsTouch = true Then WriteRoadToFile(strOutput, InfoFolder, debug)
hs.SetDeviceString(strHouseCode & Val(strDeviceCode), strOutput, true)
If Debug = true Then hs.writelog("AZ_FileInfo","Number of traffic jams(s) :" & i )
End If
End sub
'===========================================
'== Functions and SUBS ==
'===========================================
Function FindRoadNumberBlock(strWebPage, Road, Debug)
Dim strWegData as String
Dim count as Integer
Dim CalcLenght as Integer
' If Debug = true Then hs.writelog("AZ_FileInfo","FindRoadNumberBlock:Start function=" & strWebPage )
'Find start op road information
count = Instr(strWebPage, Road & "</li>")
If Debug = true Then hs.writelog("AZ_FileInfo","FindRoadNumberBlock:Search for = " & Road )
If Debug = true Then hs.writelog("AZ_FileInfo","FindRoadNumberBlock:Found at " & count )
'The requested road is found
if count > 0 then
'Drop the first part incl. the </li>
CalcLenght = Len(strWebPage) - (count + len(Road) + Len("</li>") )
If CalcLenght < 0 Then CalcLenght = 0
strWegData = "<ul><ul>" & Right(strWebPage, CalcLenght)
If Debug = true Then hs.writelog("AZ_FileInfo","FindRoadNumberBlock:Right string=" & strWegData )
'Now find the end of this block
count = Instr(strWegData, "wegnummer")
'Drop the last part
count = count - Len("<li class=") - 2
If count < 0 Then count = 0
strWegData = Left(strWegData, count )
If Debug = true Then hs.writelog("AZ_FileInfo","FindRoadNumberBlock:After left string=" & strWegData )
'Close a few tags to prevent unwanted
'generation of html code
strWegData = strWegData & "</ul></ul>"
If Debug = true Then hs.writelog("AZ_FileInfo","FindRoadNumberBlock:ReturnString=" & strWegData )
End If
return strWegData
End Function
'------------------------------------------------
'function takes three parameters.
'The first is the string to be searched through.
'The second is the string to search for.
'The third is a Boolean that determines if the search
' should be case sensitive.
'The function returns the count of occurrences
Function CountOccurrences(p_strStringToCheck, p_strSubString, p_boolCaseSensitive, Debug)
Dim arrstrTemp
Dim strBase, strToFind
If Debug = true Then hs.writelog("AZ_FileInfo","Start Count Occurences" )
If p_boolCaseSensitive Then
strBase = p_strStringToCheck
strToFind = p_strSubString
Else
strBase = LCase(p_strStringToCheck)
strToFind = LCase(p_strSubString)
End If
arrstrTemp = Split(strBase, strToFind)
CountOccurrences = UBound(arrstrTemp)
If Debug = true Then hs.writelog("AZ_FileInfo","End Count Occurences : Count = " & CountOccurrences )
End Function
'------------------------------------------------
' Write the info as a HTML file to disk so
' you can show it in a textbox on a HSTouch device
Sub WriteRoadToFile(strOutput, InfoFolder, Debug)
Dim RoadNo as String
RoadNo = Left(strOutput, Instr(strOutput, " ") - 1)
strOutput = "<HTML><BODY>" & strOutput & "</BODY></HTML>"
My.Computer.FileSystem.WriteAllText(InfoFolder & RoadNo.ToString & ".htm", strOutput.ToString & ControlChars.CrLf, False)
If debug = true then hs.writelog("AZ_FileInfo", "WriteRoadToFile start - " & strOutput)
End Sub