Home Automation Domotica Forum Europe, Bwired Forum

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