'Updated 7/12/2000 by Tom Caldwell (ttom@intelos.net)
'
'The "TvDownload.txt" script must be run before this script will work.
'You must use IR with Homeseer to use some of these options.
'This script gets a program listing for the channel asked for using the current time.
'It also allows voice commands to set a vcr to record programs. 
'Such as "whats on channel 13?" or "Record channel 13".
'It then speaks the program name retrieved or creates 2 new timed events to set 
'the vcr to record the channel. One event to change channels and start recording 
'at the time indicated and a second event to stop recording at the end of the program.
'This script also allows a command such as "whats on channel 13 at 9pm?"
'Or "record channel 13 at 9pm".
'also allows use of the day of the week.Such as "whats on channel 244 at 9pm on Saturday?"
'After HomeSeer reads the listing to you. You can say "cancel" to exit the script, 
'you can say "go there" and the script will change channels for you or say "record it"
'and have the script create the new events to record the program. 
'You can also say "details" to get homeseer to tell you what the program is about.
'The script is set to change channels using the vcr. 
'If you use the tv or dss to change channels
'you will need to change 2 lines of the script before it will work. 
'I have indicated the lines that need to be changed.
'After running the TvDownload.txt script Homeseer wont have to get on the internet to 
'retrieve the tv listings. But homeseer will have to connect to the internet to retrieve 
'the program details or to get the start and stop times to record.
'Some programs won't have details for them such as news shows.
'I use the INSTR function to skip to where my local listings starts.
'Put that into PLAYSTRING and then call HS.SPEAK
'To use this script create a new event 
'Copy and paste this voice command, minus the apostrophe into the voice command box.
'(whats on|record) channel [(1|2|3|4|5|6|7|8|9|10|11|12|13|14|15|16|17|18|19|20|30|40|50|60|70|80|90|100|200|300|400|500|600|700|800|900)+] [at (1|2|3|4|5|6|7|8|9|10|11|12|30)+ (aee'em|pee'em)] [on (Sunday|Monday|Tuesday|Wednesday|Thursday|Friday|Saturday)]
'
Option Explicit

'Options

'The next 2 constants are used if you use IR with HomeSeer.
'If set to True this const will let the script change channels for you.
Const changechannel = True

'This constant is used to set the IR device used to change channels.
'Change this to whatever device you use to change channels with. Such as
'"Satt", "TV", "VCR", "Cable"
Const irdevice = "VCR" 

'Public variables available to all subs and functions in the script.
Public startrecord
Public stoprecord
Public recorddate
Public Playstring
Public file
Public channel
Public startposition
Public timeposition
Public DayName
#include "TvDownload.txt"

sub main()
	Dim position
      	Dim endposition
      	Dim FSO
	Dim time 
	Dim checknewcommand
	Dim vcommand
	Dim newcommand
	Dim finished
	Do
		CheckWeekDay
		vcommand = hs.LastVoicecommand
		 FilePath = hs.GetAppPath & "\Script Downloads\Tv Listing"
		'These 2 lines check that a channel is asked for
		checknewcommand = ChannelNumber
		If checknewcommand = "" Then exit sub
		On Error Resume Next
		'this line sets the variable "FSO" as a variable to access the file system
      		Set FSO = CreateObject("Scripting.FileSystemObject")
		'This line uses the GetFile function to load the file into the variable 
		file = GetFile(FSO)
		'This line gets the channel number from the ChannelNumber function
      		channel = ChannelNumber
		'this line gets the search result for time asked for useing FindTime Function
		time = FindTime
		If time = 0 then
			hs.speak "i'm sorry but channel" & channel & "is not listed" 
			Exit Sub
      		End if
		'Find where tv channel begins
		startposition = Instr ( time, file, channel & "&chanArea")
      		position = Instr( startposition , file, ">")
      		position = position + 1
      		endposition = Instr( startposition, file, "<")
		'Get the chars between > and < signs
      		Playstring = Mid( file, position , endposition - position)
		If Left(hs.LastVoicecommand,6) = "record" then
			VcrRecord
			Exit Sub
		Else
			hs.speak Playstring
			finished = False
		End If
		
		Do While finished = False 
			'clears out last voice newcommand
			hs.LastVoicecommand=""
			' create our own private recognition list
			hs.AddVoicecommand "go there"
			hs.AddVoicecommand "cancel"
			hs.AddVoicecommand "(whats on|record) channel [(1|2|3|4|5|6|7|8|9|10|11|12|13|14|15|16|17|18|19|20|30|40|50|60|70|80|90|100|200|300|400|500|600|700|800|900)+] [at (1|2|3|4|5|6|7|8|9|10|11|12|30)+ (aee'em|pee'em)]"
			hs.AddVoicecommand "details"
			hs.AddVoicecommand "record it"
			' wait for a voice command
			do
				newcommand = hs.LastVoicecommand
				If newcommand <> "" then exit do
				hs.WaitEvents
			loop
			' check the actual newcommand
			If newcommand = "go there" Then
				If changechannel = True Then
					'hs.speak "changing channels"
					GoToChannel
					Finished = True
				End If
			ElseIf newcommand = "cancel" Then
				hs.speak "cancel"
				finished = True
			ElseIf newcommand = "details" Then
				hs.speak "getting details"
				TvProgramDetails(True)
				If Playstring = "" Then
					finished = True
				Else
					finished = False
				End If
			ElseIf newcommand = "record it" Then
				VcrRecord
				finished = True
			Else
				finished = True
			End If
		Loop
		hs.LastVoiceCommand = ""
		If newcommand = "cancel" Then Exit Do
		If newcommand = "go there" Then Exit Do
		If newcommand = "record it" Then Exit Do
	Loop
End Sub

'This function returns the file asked for
Function GetFile(FSO)
      	Dim TextStream
      	Dim S
      	Dim TextFile
	Dim TimeAsked
	
	TimeAsked = ChooseFile
	Set TextFile = FSO.GetFile(FilePath & "\" & DayName & "\" & TimeAsked & ".txt")
	Set TextStream = TextFile.OpenAsTextStream(OpenFileForReading) 
	Do While Not TextStream.AtEndOfStream 
		S = S & TextStream.ReadLine 
	Loop 
	TextStream.Close 
	GetFile = S
End Function

Sub CheckWeekDay
	Dim word
	Dim count
	Dim cwdcommand
	Dim command

	cwdcommand = hs.LastVoiceCommand
	count = 0
	Do
		count = count + 1
      		word = trim(hs.stringItem(cwdcommand, count, " "))
		If word = "Sunday" Then
 			DayName = word 
			count = count + 1
		ElseIf word = "Monday" Then
			DayName = word 
			count = count + 1
		ElseIf word = "Tuesday" Then
			DayName = word
			count = count + 1 
		ElseIf word = "Wednesday" Then
			DayName = word
			count = count + 1 
		ElseIf word = "Thursday" Then
			DayName = word
			count = count + 1 
		ElseIf word = "Friday" Then
			DayName = word 
			count = count + 2
		ElseIf word = "Saturday" Then
			DayName = word
			count = count + 1 
		End If
	Loop Until word = ""
	If DayName = "" Then DayName = WeekDayName(WeekDay(NOW))
	count = 0
	Do
		count = count + 1
      		word = trim(hs.stringItem(cwdcommand, count, " "))
		command = command & word & " "
		If word = "pee'em" Then Exit Do
		If word = "aee'em" Then Exit Do
	Loop Until word = "" 
	hs.lastvoicecommand = trim(command)
End Sub

Function GetEventID(name)
	' function to return the EventID for a given event name; returns 0 if not found
	dim teventcount
	dim i
	'get total eventcount
	teventcount = hs.eventcount
	'set default event id
	GetEventID = 0
	for i = 1 to teventcount
		'check for matching event name
		if trim(ucase(hs.getevent(i).name)) = ucase(name) then
			GetEventID = i
			exit for
		end if
	next
End Function

Sub VcrRecord
	Dim currenthour
	Dim currentminute
	Dim currenttime
	Dim num
	Dim count
	Dim word
	Dim RecordEvent
	Dim StopRecordEvent
	Dim CurrentEv
	Dim RecordTime

	hs.speak "creating events to record this program"
	TvProgramDetails(false)
	currenthour = Hour(Now) 
	If currenthour > 12 then currenthour = currenthour - 12
	currentminute = Minute(Now) + 1
	If currentminute <10 Then currentminute = "0" & currentminute
	currenttime = currenthour & ":" & currentminute & " " & Lcase(Right(Now,2))
	If startrecord < currenttime And Dayname = WeekDayName(WeekDay(Now))Then startrecord = currenttime
	'Creates a new time event to start vcr recording
	hs.NewTimeEvent "Vcr Record",startrecord, recorddate, 1, 1, 1, 1, 1, 1, 1, "", 1, ""
	RecordEvent = GetEventID("Vcr Record")
	Set CurrentEv = hs.GetEvent(RecordEvent)

	If channel < 10 then
		If LCase(irdevice) = LCase("VCR") Then
			CurrentEv.ir = irdevice & ",0," & channel & "," & "Record"
		Else
			CurrentEv.ir = irdevice & ",0," & channel & "," & "VCR,Record"
		End If
	Else	
		' Loop through all numbers in channel
		count = 0
		DO
			count = count + 1
			word = Mid(channel, count, 1)
     			num = num & word & ","
		LOOP UNTIL count = Len(channel)
		If LCase(irdevice) = LCase("VCR") Then
			CurrentEv.ir = irdevice & "," & num & "Record"
		Else
			CurrentEv.ir = irdevice & "," & num & "VCR,Record"
		End If
	End If
	'Creates a new time event to stop vcr recording
	hs.NewTimeEvent "Vcr Stop Record",stoprecord, recorddate, 1, 1, 1, 1, 1, 1, 1, "", 1, ""
	StopRecordEvent = GetEventID("Vcr Stop Record")
	Set CurrentEv = hs.GetEvent(StopRecordEvent)
	CurrentEv.ir = "VCR,Stop"
End Sub

Sub TvProgramDetails(read)
	Dim amorpm
	Dim char
	Dim count
	Dim timestring
	Dim starttimepointer
	Dim endtimepointer
	Dim programstart
	Dim string
	Dim host
	Dim page
	Dim strip_tags
	Dim port
	Dim Webpage
	Dim channelcodenumber
	Dim tpdarea
	Dim tpdDate
	Dim startstring
	Dim endstring

	tpdarea = GetArea
	tpddate = FormatDate
	channelcodenumber = Mid(file,startposition - 9,5)
	host = "tv.yahoo.com"
	page = "/yahoo/listings/showProgram.dpg?params=" & tpdDate & "," & channelcodenumber & "," & timeposition & "," & channel & "&chanArea=" & tpdarea
	strip_tags = True
	port = 80
	Webpage = hs.GetURL(host, page, strip_tags, port)
	Playstring = ""
	string = Instr( webpage, channel)
	If read = False Then
		starttimepointer = Instr(string,webpage," ")
		endtimepointer = Instr(starttimepointer,webpage,chr(13))
		If endtimepointer = 0 Then endtimepointer = Instr( string, webpage, chr(10))
		timestring = Mid( webpage, starttimepointer, endtimepointer - starttimepointer)
		amorpm = Right(timestring,2)
		count = 0
		DO
			count = count + 1
			char = Mid(timestring, count, 1)
			If char = "-" Then Exit Do
     			startrecord = startrecord & char
		LOOP UNTIL count = Len(timestring)
		If Len(startrecord) < 4 Then
			startrecord = startrecord & ":00" & " " & amorpm
		Else
			startrecord = startrecord & " " & amorpm
		End If
		
		'continues counting from the last count
		DO
			count = count + 1
			char = Mid(timestring, count, 1)
			If char = "p" or char = "a" Then exit Do
     			stoprecord = stoprecord & char
		LOOP UNTIL count = Len(timestring)
		If Len(stoprecord) < 4 Then
			stoprecord = stoprecord & ":00" & " " & amorpm
		Else
			stoprecord = stoprecord & " " & amorpm
		End If	
		Exit Sub
	Else
	End If
	startstring = Instr( string, webpage, chr(10))
	If startstring = 0 Then startstring = Instr( string, webpage, chr(13))
	endstring = Instr(startstring,webpage,"CC")
	If endstring = 0 Then endstring = Instr(startstring,webpage,"Adventure")
	If endstring = 0 Then endstring = Instr(startstring,webpage,"Biography")
	If endstring = 0 Then endstring = Instr(startstring,webpage,"Children")
	If endstring = 0 Then endstring = Instr(startstring,webpage,"Comedy")
	If endstring = 0 Then endstring = Instr(startstring,webpage,"Crafts")
	If endstring = 0 Then endstring = Instr(startstring,webpage,"Crime-Mystery")
	If endstring = 0 Then endstring = Instr(startstring,webpage,"Documentary")
	If endstring = 0 Then endstring = Instr(startstring,webpage,"Drama")
	If endstring = 0 Then endstring = Instr(startstring,webpage,"Education")
	If endstring = 0 Then endstring = Instr(startstring,webpage,"Fantasy")
	If endstring = 0 Then endstring = Instr(startstring,webpage,"Finance")
	If endstring = 0 Then endstring = Instr(startstring,webpage,"Game")
	If endstring = 0 Then endstring = Instr(startstring,webpage,"Health")
	If endstring = 0 Then endstring = Instr(startstring,webpage,"History")
	If endstring = 0 Then endstring = Instr(startstring,webpage,"Horror")
	If endstring = 0 Then endstring = Instr(startstring,webpage,"Infotainment")
	If endstring = 0 Then endstring = Instr(startstring,webpage,"Lifestyles")
	If endstring = 0 Then endstring = Instr(startstring,webpage,"Movies")
	If endstring = 0 Then endstring = Instr(startstring,webpage,"Music")
	If endstring = 0 Then endstring = Instr(startstring,webpage,"Nature")
	If endstring = 0 Then endstring = Instr(startstring,webpage,"News")
	If endstring = 0 Then endstring = Instr(startstring,webpage,"Other")
	If endstring = 0 Then endstring = Instr(startstring,webpage,"Religion")
	If endstring = 0 Then endstring = Instr(startstring,webpage,"Romance")
	If endstring = 0 Then endstring = Instr(startstring,webpage,"Sci-fi")
	If endstring = 0 Then endstring = Instr(startstring,webpage,"Science")
	If endstring = 0 Then endstring = Instr(startstring,webpage,"Soap")
	If endstring = 0 Then endstring = Instr(startstring,webpage,"Sports")
	If endstring = 0 Then endstring = Instr(startstring,webpage,"Talk")
	If endstring = 0 Then endstring = Instr(startstring,webpage,"Travel")
	If endstring = 0 Then endstring = Instr(startstring,webpage,"Western")
	Playstring = Mid( webpage, startstring, endstring - startstring)
	hs.speak playstring
End Sub

'This sub changes channel
sub GoToChannel
	dim count
	dim word
	Dim i
	' speak something
	ah.speak "changing channel"
	' send the command to the PC/IR Linc
	If channel < 10 then
		ah.SendIR irdevice & ",0,"&channel
	Else	
		' Loop through all numbers in channel
		count = 0
		DO
			count = count + 1
			word = Mid(channel, count, 1)
     			ah.SendIR irdevice & "," & word
		LOOP UNTIL count = Len(channel)	
	End If
End sub

'This function finds and returns the position of the time and channel number in the file.
Function FindTime
	Dim timepointer		
	'find where time begins
	timeposition = GetTime
	timeposition = FormatTime(timeposition)
	Do 
		timepointer = Instr ( file, timeposition & "," & channel & "&chanArea")
		If timepointer = 0 Then
			timeposition = timeposition - 1
		Else 
			Exit Do
		End If
		If timeposition < 1 Then 
			Exit Do
		End If
		hs.waitevents
	Loop Until timepointer > 0
	FindTime = timepointer
End Function

'This function returns the time asked for in the voice command.
'If no time is asked for then it returns the current system time
Function GetTime
	Dim systime
	Dim amorpm
	Dim syshour
	Dim sysminute
	Dim gtnewcommand
	Dim checklastnumber
	Dim count
	Dim word
	'gets last voice command
      	gtnewcommand = trim(hs.LastVoicecommand)
	count = 0
	checklastnumber = right(gtnewcommand,5)
	DO
		count = count + 1
      		word = trim(hs.stringItem(gtnewcommand, count, " "))
		If word = "pee'em" or word = "aee'em" Then
			If word = "pee'em" Then word = "pm" 
			If word = "aee'em" Then word = "am" 
			gtnewcommand = StrReverse(gtnewcommand)
			checklastnumber = Mid(gtnewcommand,9,1)
			If IsNumeric(checklastnumber) Then
				checklastnumber = Mid(gtnewcommand,8,2)
				checklastnumber = StrReverse(checklastnumber)
				If checklastnumber = 30 Then
					systime = Trim(StrReverse(mid(gtnewcommand,10,3))) & ":" & checklastnumber & word
					Exit Do
				Else
					systime = checklastnumber & ":" & "00" & word
					Exit Do
				End If
			Else 
				checklastnumber =Mid(gtnewcommand,8,1)
				checklastnumber = StrReverse(checklastnumber)
				systime = checklastnumber & ":" & "00" & word
				Exit Do
			End If
		Else
			amorpm = LCase(Right(Time,2))
			syshour = Hour(Time)
			If syshour > 12 Then 
				syshour = syshour - 12 
			End If
			sysminute = Minute(Now)
			If sysminute < 30 Then 
				sysminute = "00"
			Else
				sysminute = "30"
			End If
      			systime = syshour & ":" & sysminute & amorpm
		END IF
	LOOP UNTIL word = ""
	gtnewcommand = StrReverse(gtnewcommand)
	GetTime = systime  
End Function

'This function returns the channel number asked for in the voice newcommand
Function ChannelNumber
      Dim count
      Dim word
      Dim number
      Dim newcommand
      'gets last voice newcommand
      newcommand = hs.LastVoicecommand
      count = 0
      ' Loop through all words in the command, looking for numbers
      DO
		count = count + 1
      		word = trim(hs.stringItem(newcommand, count, " "))
		If word = "at" Then 
			Exit Do
		End If
		IF IsNumeric(word) THEN
        		number = number + abs(word)
			ChannelNumber = number
		END IF
		hs.waitevents
	LOOP UNTIL word = ""
End Function

'This function returns the file choice based on the time.
Function ChooseFile
	Dim FileChoice
	FileChoice = GetTime
	FileChoice = FormatTime(FileChoice)
	If FileChoice > 41 and FileChoice < 0 Then
		FileChoice = 3
	ElseIf FileChoice > 47 and FileChoice < 6 Then
		FileChoice = 6
	ElseIf FileChoice > 5 and FileChoice < 12 Then
		FileChoice = 9
	ElseIf FileChoice > 11 and FileChoice < 18 Then
		FileChoice = 12
	ElseIf FileChoice > 17 and FileChoice < 24 Then
		FileChoice = 15
	ElseIf FileChoice > 23 and FileChoice < 30 Then
		FileChoice = 18
	ElseIf FileChoice > 29 and FileChoice < 35 Then
 		FileChoice = 21
	ElseIf FileChoice > 35 and FileChoice < 42 Then
		FileChoice = 24
	End If
	ChooseFile = FileChoice
End Function

'This function returns the time formatted
Function FormatTime(changetime)
	Select Case changetime
		Case "1:00am"  changetime = 38
		Case "1:30am"  changetime = 39
		Case "2:00am"  changetime = 40
		Case "2:30am"  changetime = 41
		Case "3:00am"  changetime = 42
		Case "3:30am"  changetime = 43
		Case "4:00am"  changetime = 44
		Case "4:30am"  changetime = 45
		Case "5:00am"  changetime = 46
		Case "5:30am"  changetime = 47
		Case "6:00am"  changetime = 0
		Case "6:30am"  changetime = 1
		Case "7:00am"  changetime = 2
		Case "7:30am"  changetime = 3
		Case "8:00am"  changetime = 4
		Case "8:30am"  changetime = 5
		Case "9:00am"  changetime = 6
		Case "9:30am"  changetime = 7
		Case "10:00am" changetime = 8
		Case "10:30am" changetime = 9
		Case "11:00am" changetime = 10
		Case "11:30am" changetime = 11
		Case "12:00pm" changetime = 12
		Case "12:30pm" changetime = 13
		Case "1:00pm"  changetime = 14
		Case "1:30pm"  changetime = 15
		Case "2:00pm"  changetime = 16
		Case "2:30pm"  changetime = 17
		Case "3:00pm"  changetime = 18
		Case "3:30pm"  changetime = 19
		Case "4:00pm"  changetime = 20
		Case "4:30pm"  changetime = 21
		Case "5:00pm"  changetime = 22
		Case "5:30pm"  changetime = 23
		Case "6:00pm"  changetime = 24
		Case "6:30pm"  changetime = 25
		Case "7:00pm"  changetime = 26
		Case "7:30pm"  changetime = 27
		Case "8:00pm"  changetime = 28
		Case "8:30pm"  changetime = 29
		Case "9:00pm"  changetime = 30
		Case "9:30pm"  changetime = 31
		Case "10:00pm" changetime = 32
		Case "10:30pm" changetime = 33
		Case "11:00pm" changetime = 34
		Case "11:30pm" changetime = 35 
		Case "12:00am" changetime = 36
		Case "12:30am" changetime = 37
	End Select 
	FormatTime = changetime
End Function

Function FormatDate
	Dim todaysday
	Dim daygiven
	Dim urldate
	Dim currentmonth
	Dim currentday
	Dim currentyear
	Dim todaysdayname

	currentday = Day(Now)
	currentyear = Right(Year(Now),2)
	currentmonth = Month(Now)
	todaysdayname = WeekDayName(WeekDay(Now))
	todaysday = WeekDay(Now)
	Select Case DayName
		Case "Sunday"		daygiven = 1
		Case "Monday"		daygiven = 2
		Case "Tuesday"		daygiven = 3
		Case "Wednesday"	daygiven = 4
		Case "Thursday"		daygiven = 5
		Case "Friday"		daygiven = 6
		Case "Saturday"		daygiven = 7
	End Select		
	If todaysdayname <> DayName Then
		If todaysday = 7 Then
			currentday = currentday + daygiven
		Else
			currentday = currentday + (daygiven - todaysday)
		End If
	End If
	recorddate = currentmonth & "/" & currentday & "/" & currentyear
	If currentday < 10 then currentday = "0" & currentday
	If currentmonth < 10 then currentmonth = "0" & currentmonth
	urldate = currentmonth & currentday & currentyear
	FormatDate = urldate
End Function