iviewnapperlitemod

' Subroutines for iViewNapperLite.

' Global Variables
dim serImgArray()
dim epTitleArray()
dim epListBoxArray()
dim epDescArray()
dim epVideoAssetArray()
Dim arrSeriesList()
docTitle = "iViewNapperLite 20110320 series"
document.title = docTitle

'******************************
'*     PC 20110329
'*     Modification to
'*        1.  Download episodes of series
'*        2.  Auto resume of stored series and partials
'*        3.  Log series/download commands
'*
'******************************
'
'
'If Changes to servers, look for
' URL for ABC authentication server
'  URL = "http://tviview.abc.net.au/iview/auth/?v2"
'  Hostworks and Akamai
'      r = " -e -r rtmp://203.18.195.10/"
'      t = " -t rtmp://cp53909.edgefcs.net/ondemand?auth=""" & token & """"
'
'  Version
'  x = "rtmpdump-win32-2.2d.exe"
'
'  Logging commands
'  strFile = ".\lastcmd.cmd"





' Runs when window loads
Sub Window_Onload
  ' Resize Window
  x = 784
  y = 564
  window.resizeTo x, y

  ' Centre Window
  x = (window.screen.width - x) / 2
  y = (window.screen.height - y) / 2
  If x < 0 Then x = 0
  If y < 0 Then y = 0
  window.moveTo x, y

'----------------------------
' read Series short names into array
'----------------------------
Dim objFSO, objFolder, objShell, objTextFile, objFile
Dim strDirectory, strFile, strText

strDirectory = "."
strFile = "\seriesnames.txt"
strText = shortname

' Create the File System Object
Set objFSO = CreateObject("Scripting.FileSystemObject")

set objFile = nothing
set objFolder = nothing

' OpenTextFile Method needs a Const value
' ForAppending = 8 ForReading = 1, ForWriting = 2
Const ForReading = 1

Set objTextFile = objFSO.OpenTextFile (strDirectory & strFile, ForReading, True)
sercount = 0
Do Until objTextFile.AtEndOfStream
        strNextLine = objTextFile.Readline
        redim preserve arrSeriesList(sercount)
    arrSeriesList(sercount) = strNextLine
    sercount = sercount + 1
Loop

objTextFile.Close

'----------------------------



  ' Get A-L JSON file
  j1 = getURL("http://tviview.abc.net.au/iview/api2/?keyword=a-l")
  j1 = left(j1, len(j1) - 1)

  ' Get M-Z JSON file
  j2 = getURL("http://tviview.abc.net.au/iview/api2/?keyword=m-z")
  j2 = right(j2, len(j2) - 1)

  ' Combine JSON files and Deserialize
  set myJSON = JSON.parse(j1 & "," & j2)

  ' Process JSON and Populate Listbox
  num = 0
  for each show in myJSON
    num = num + show.f.length
  next

  document.title = docTitle & " json- " & num & " episodes"

  ' Populate arrays
  redim serImgArray(num)
  redim epTitleArray(num)
  redim epListBoxArray(num)
  redim epDescArray(num)
  redim epVideoAssetArray(num)


  ' Process each show
  counter = 0
  for each show in myJSON
    ' Do not add shopdownload episodes
    if not (InStr(lcase(show.e), "shopdownload") > 0) then
      for each episode in show.f
        serImgArray(counter) = show.d

        ' Video Asset
        va = episode.n
        epVideoAssetArray(counter) = va

        ' Episode Title
         t2 = show.b & " -- " & episode.b
        t2 = Replace(t2, "&amp;", "and")
        t2 = Replace(t2, "/", "-")
        t2 = Replace(t2, ":", " -")
        t2 = Replace(t2, "?", "")
        t2 = Replace(t2, "*", "-")
        t2 = Replace(t2, chr(9), " ")
        t2 = left(t2, 75)
        epTitleArray(counter) = t2

    ' find episode title in series array and start download




        ' File Size
        sz = ""
        on error resume next
        sz = episode.i
        on error goto 0
        sz = IIf(sz = "", "UNKNOWN", sz + " MB")

        ' Duration
        du = "0"
        on error resume next
        du = "0" & cstr(episode.j)
        on error goto 0
        du = cstr(Int(du / 60))
        du = IIf(du = "0", "UNKNOWN", du + " min")
        epListBoxArray(counter) = padright(t2, 75) & padright(padleft(du, 8), 9) & padleft

(sz, 8)

        ' Short Title
        st = ""
        on error resume next
        st = episode.c
        on error goto 0
        st = Replace(st, "&amp;", "and")
        st = st + IIf(len(st) > 0, " ", "")

        ' pubDate
        pd = episode.f
        pd = "(" & split(pd)(0) & ") "

        ' Description
        ds = episode.d
        ds = replace(ds, "&lt;", "<")
        ds = replace(ds, "&gt;", ">")
        ds = replace(ds, "&quot;", "'")
        ds = replace(ds, chr(13), "")
        ds = replace(ds, chr(10), "")
        ds = trim(ds)

        ex = " [" & UCase(Right(va, 3)) & "] "
        epDescArray(counter) = st & pd & ds & ex
        counter = counter + 1

      next
    end if
  next
  counter = counter - 1
  redim preserve serImgArray(counter)
  redim preserve epTitleArray(counter)
  redim preserve epDescArray(counter)
  document.title = docTitle & " sorting- " & counter & " episodes"



  ' Sort arrays alphabetically on episode titles
  for i = UBound(epTitleArray) - 1 To 0 Step -1
    for j = 0 to i
      if epTitleArray(j) > epTitleArray(j + 1) then
        ' Sort serImgArray
        temp = serImgArray(j + 1)
        serImgArray(j + 1) = serImgArray(j)
        serImgArray(j) = temp
        ' Sort epTitleArray
        temp = epTitleArray(j + 1)
        epTitleArray(j + 1) = epTitleArray(j)
        epTitleArray(j) = temp
        ' Sort epListBoxArray
        temp = epListBoxArray(j + 1)
        epListBoxArray(j + 1) = epListBoxArray(j)
        epListBoxArray(j) = temp
        ' Sort epDescArray
        temp=epDescArray(j + 1)
        epDescArray(j + 1) = epDescArray(j)
        epDescArray(j) = temp
        ' Sort epVideoAssetArray
        temp=epVideoAssetArray(j + 1)
        epVideoAssetArray(j + 1) = epVideoAssetArray(j)
        epVideoAssetArray(j) = temp
      end if
    next
  next

  document.title = docTitle & " loading - " & counter & " episodes: populating"

 ' Select first episode
  document.getElementById("listbox").selectedIndex = 0
  listbox_onclick(0)

  ' Populate listbox
  for i = 0 To UBound(epTitleArray) - 1
    dim opt
    set opt = document.createelement("option")
    opt.text = epListBoxArray(i)
    listbox.add opt
    set opt = nothing

'----------------------------
    'match and get series
'----------------------------
  ser=InStr(epTitleArray(i),"Series") - 2 'has the word series in title?
  if ser > 0 Then
    For Each Series in arrSeriesList
    if InStr(epTitleArray(i),Series) > 0 Then
        ' select and get episode
        document.getElementById("listbox").selectedIndex = i
        listbox_onclick(0)
        fetchEpisode
    End If
     next
  End IF
  next

  ' Select first episode
  document.getElementById("listbox").selectedIndex = 0
  document.getElementById("listbox").scrollTop = 0
  listbox_onclick(0)

  document.title = docTitle & " - " & counter & " episodes"



End Sub








' listbox on single click event
Sub listbox_onclick(num)
  if isNumeric(num) then
    document.getElementById("textbox").value = epDescArray(num)
    document.getElementById("picbox").src = serImgArray(num)
  end if
End Sub

' listbox on change event
Sub listbox_onchange
  listbox_onclick(document.getElementById("listbox").selectedIndex)
End Sub

' picbox on double click event
Sub picbox_ondblclick
  fetchEpisode
End Sub

' Clears the listbox box
Sub clear_listbox
  document.getElementById("listbox").options.length = 0
End Sub

Sub fetchEpisode
  ' URL for ABC authentication server
  URL = "http://tviview.abc.net.au/iview/auth/?v2"

  ' Extract token and other values
  set xmlDoc=CreateObject("Microsoft.XMLDOM")
  xmlDoc.async="false"
  xmlDoc.load(URL)
  token = xmlDoc.documentElement.selectSingleNode("/iview/token").text
  host = xmlDoc.documentElement.selectSingleNode("/iview/host").text
  free = xmlDoc.documentElement.selectSingleNode("/iview/free").text
  set xmlDoc = Nothing

  ' Init some content server parameter variables
  num = document.getElementById("listbox").selectedIndex
  show = left(epVideoAssetArray(num), len(epVideoAssetArray(num)) - 4)
  ext = Right(epVideoAssetArray(num), 3)

  ' Setup the content server parameters for host
  x = "rtmpdump-win32-2.2d.exe"
  o = " -o " & """" & epTitleArray(num) & "." & ext & """"
  W = " -W ""http://www.abc.net.au/iview/images/iview.jpg"""
  z = ""
  Select Case Ucase(host)
    Case  "HOSTWORKS"
      r = " -e -r rtmp://203.18.195.10/"
      asset = iif(ext="mp4", "&mp4:" & show, "")
      a = " -a ondemand?auth=""" & token  & asset & """"
      show = iif(ext = "mp4", "mp4:", "") & show
      y = " -y " & """" & show & """"
      cmd = x & r & a & y & o & W & z
    Case "AKAMAI"
      show = iif(ext = "mp4", show & "." & ext, show)
      r = " -e -r rtmp://cp53909.edgefcs.net////flash/playback/_definst_/" & show
      t = " -t rtmp://cp53909.edgefcs.net/ondemand?auth=""" & token & """"
      cmd = x & r & t & o & W & z
    Case Else
      msgbox "Content server not listed."
  End Select

' save "in progress" series titles
  ser=InStr(epTitleArray(num),"Series") - 2
  if ser > 0 Then
  'search series array for duplicates
    k = 1
    For Each Series in arrSeriesList
    if InStr(epTitleArray(num),Series) > 0 Then k = 0 'found
    Next
    ' save new series for future
    if k = 1 Then saveSeries(Left(epTitleArray(num),ser))

  End  If



  ' Spawn DOS shell and run app
  Set wshShell = CreateObject("WScript.Shell")

  saveFetchCmd(cmd)

  wshShell.Run cmd

  Set wshShell = Nothing
  Set xmlDoc = Nothing
End Sub ' fetch



' Immediate IF function.
Function iif(tstStr, trueStr, falseStr)
  if tstStr then
    iif = trueStr
  else
    iif = falseStr
  end if
End Function

' Padleft function.
Function padleft(str, num)
  padleft = space(num - len(str)) & str
End Function

' Padright function.
Function padright(str, num)
  padright = str & space(num - len(str))
End Function

' Gets the file from the internet.
Function getURL(URL)
  dim http
  set http = CreateObject("Microsoft.XMLHTTP")
  http.Open "GET", URL, false
  http.Send
  getURL = http.ResponseText
End Function


' NewTextEC.vbs
' FRom a Sample VBScript to write to a file. With added error-correcting
' Author Guy Thomas http://computerperformance.co.uk/
' Version 1.5 - August 2005
' ---------------------------------------------------------------'

Sub saveFetchCmd(cmd)
'Option Explicit
Dim objFSO, objFolder, objShell, objTextFile, objFile
Dim strDirectory, strFile, strText
strDirectory = "."
strFile = "\lastseriescmd.cmd"
strText = cmd

' Create the File System Object
Set objFSO = CreateObject("Scripting.FileSystemObject")

' Check that the strDirectory folder exists
If objFSO.FolderExists(strDirectory) Then
   Set objFolder = objFSO.GetFolder(strDirectory)
Else
   Set objFolder = objFSO.CreateFolder(strDirectory)
   WScript.Echo "Just created " & strDirectory
End If

If objFSO.FileExists(strDirectory & strFile) Then
   Set objFolder = objFSO.GetFolder(strDirectory)
Else
   Set objFile = objFSO.CreateTextFile(strDirectory & strFile)
'   Wscript.Echo "Just created " & strDirectory & strFile
End If

set objFile = nothing
set objFolder = nothing
' OpenTextFile Method needs a Const value
' ForAppending = 8 ForReading = 1, ForWriting = 2
Const ForAppending = 8

Set objTextFile = objFSO.OpenTextFile _
(strDirectory & strFile, ForAppending, True)

' Writes strText every time you run this VBScript
objTextFile.WriteLine(strText)
objTextFile.Close

' Bonus or cosmetic section to launch explorer to check file
'If err.number = vbEmpty then
'   Set objShell = CreateObject("WScript.Shell")
'   objShell.run ("Explorer" &" " & strDirectory & "\" )
'Else
'   WScript.echo "VBScript Error: " & err.number
'End If

End Sub


'should merge this and above into single append string to file sub
Sub saveSeries(shortname)
'Option Explicit
Dim objFSO, objFolder, objShell, objTextFile, objFile
Dim strDirectory, strFile, strText
strDirectory = "."
strFile = "\seriesnames.txt"
strText = shortname

' Create the File System Object
Set objFSO = CreateObject("Scripting.FileSystemObject")

' Check that the strDirectory folder exists
If objFSO.FolderExists(strDirectory) Then
   Set objFolder = objFSO.GetFolder(strDirectory)
Else
   Set objFolder = objFSO.CreateFolder(strDirectory)
   WScript.Echo "Just created " & strDirectory
End If

If objFSO.FileExists(strDirectory & strFile) Then
   Set objFolder = objFSO.GetFolder(strDirectory)
Else
   Set objFile = objFSO.CreateTextFile(strDirectory & strFile)
'   Wscript.Echo "Just created " & strDirectory & strFile
End If

set objFile = nothing
set objFolder = nothing
' OpenTextFile Method needs a Const value
' ForAppending = 8 ForReading = 1, ForWriting = 2
Const ForAppending = 8

Set objTextFile = objFSO.OpenTextFile _
(strDirectory & strFile, ForAppending, True)

' Writes strText every time you run this VBScript
objTextFile.WriteLine(strText)
objTextFile.Close

' Bonus or cosmetic section to launch explorer to check file
'If err.number = vbEmpty then
'   Set objShell = CreateObject("WScript.Shell")
'   objShell.run ("Explorer" &" " & strDirectory & "\" )
'Else
'   WScript.echo "VBScript Error: " & err.number
'End If

End Sub