Hi,
I like to see a lot of shows that are published on the Internet on a regularly basis but the website does not provide a asx or generic URLs that is automatically updated with the last version of the show. But in general these links have Keep the same format and only change the date based on their last diffusion.
So I developped a small VBscript that Add automatically (I scheduled it to run at the boot of my system and every 2 hours) these shows to my Tversity media server.
I provide this script as-is and will not provide any support on that but if you have question post a message under that subject and I will take a look a it when I have time.
Please Note that The cut&past in this forum removed all the indentation of the script and XML file that make more difficult to read them but it should not cause any issue when comes time to run the script
This is an example of the XML file to use
<?xml version="1.0" encoding="UTF-8"?> http://www.m6.fr/content/video/info/asx/Lyon_00_|2d||2m||2y|.asx M6 Lyon - |4y||2m||2d| Emissions.JT Yes Video URL Monday 2006-12-18 Tuesday 2006-12-19 Wednesday 2006-12-20 Thursday 2006-12-21 Friday 2006-12-22 Saturday Sunday http://www.m6.fr/content/video/info/asx/Bordeaux_00_|2d||2m||2y|.asx M6 Bordeaux - |4y||2m||2d| Emissions.JT Yes Video URL Monday 2006-12-18 Tuesday 2006-12-19 Wednesday 2006-12-20 Thursday 2006-12-21 Friday 2006-12-22 Saturday SundayThis is the script Listing (to be copied on a file with an vbs extension)
'*******************************************************************************
'*** Author : Ced
'*** Created : 15/12/2006
'*** Last Modified : 16/12/2006
'*** Version : 1.0
'*** Description : This script Update automatically Tversity Media with the URL of weekly shows
'*** Argument(s) : N/A
'*** Input File(s) : An XML file named CONST_INPUTXMLFILEPATH that contains the details about the URL to create
'*** Output file(s) : Log file (scriptName.log) - Contains script execution details
'*** URL file (scriptname-URLs.txt) - Contains a list of all URL added by the script to the Tversity Media server
'*** Remarks : A example of XML file is provided with this script. If the input XML file is not correctly formatted the script rename it
'*** and Create a new template one.
'*** Warning: the XML tags are case sensitive.
'***
'*** URL and Title Tags in the Input file accept the following macros in their string:
'*** |4y| -> replaced by the year on 4 positions (eg: 2006)
'*** |2y| -> replaced by the year on 2 positions (eg: 06)
'*** |2m| -> replaced by the month on 2 positions (eg: 01)
'*** |1m| -> replaced by the month on 1 position (eg: 1)
'*** |2d| -> replaced by the day on 2 positions (eg: 02)
'*** |1d| -> replaced by the day on 1 position (eg: 2)
'***
'*** Note: As Tversity does not accept two URLs with the same Title, it’s important
'*** To add Date macros in the Title string
'***
'*** Note2: Keep the LastUpdated field empty when you create a new schedule, the script will fill it automatically
'*** The first time it will run
'***
'*******************************************************************************
'*** Version 1.0: Initial Release
'*** Script Options
OPTION EXPLICIT
'*** Script Constants - TO BE CUSTOMIZED AS REQUIRED
Const CONST_INPUTXMLFILEPATH = “TversityAutoUpdate-Input.xml” '*** This is the path of the XML file containing URL information
Const CONST_TVERSITYPATH = “D:\Program Files\TVersity\Media Server” '*** Tversity path where the MSHARE Tool is installed. Do not forget to finish with \
Const CONST_SUCCESS_STRING = “added/updated” '*** This string is used to analyse output of the Mshare command and determine if command succeeded or not
'*** Global Variables Declaration
'Add your global variable declaration here
Dim gDEBUG '** BOOLEAN 0=DEBUG DEACTIVATED 1=DEBUG ACTIVATED
Dim gobjFso '** FILESYSTEM OBJECT Object file system use for all files operation
Dim gFirstDayofTheWeek
'*** Global Variables Initialization
gDEBUG = 0
gFirstDayofTheWeek=vbMonday
'*** Script Entry point
main
'***************************************
'*** Procedures and functions
'***************************************
sub main ()
'*****************************************************
'*** Main procedure - Entry point of the script
'*** (Keep this procedure as small as possible)
'*****************************************************
If (gDEBUG=0) Then On Error Resume Next
'*** Create an instance of Filesystem object
Set gobjFso=CreateObject("Scripting.FileSystemObject")
Call WriteLog("INFO;Script started")
'*** Verify if XML file exist and its correct, create if required.
If CheckXMLFile(CONST_INPUTXMLFILEPATH)=True then
ParseMediaInfo
End if
Call WriteLog("INFO;Script Ended")
End Sub
Function ParseMediaInfo()
'*****************************************************
'*** Purpose: This procedure Read the Input XML file to get the URL Information
'*** Inputs :
'*** Returns:
'***
'*****************************************************
If (gDEBUG=0) Then On Error Resume Next
Dim objXMLDoc '*** XMLDOC Document Object corresponding to the STATE FILE
Dim objrootElement '*** XMLELEMENT Get the root element of the XML document
Dim objNode '*** XMLNODE Node Object corresponding to one MediaURL
if (gDEBUG=1) then WriteLog "DEBUG; ParseMediaInfo;XML File treated: " & CONST_INPUTXMLFILEPATH
'*** Load XML File in Memory
set objXMLDoc=CreateObject("Microsoft.XMLDOM")
objXMLDoc.async="false"
objXMLDoc.load(CONST_INPUTXMLFILEPATH)
'*** Test if XML file could be read properly
if objXMLDoc.parseError.ErrorCode <> 0 then
'*** Error during reading of the XML Document
Call WriteLog("ERROR;' ParseMediaInfo' for '" & strVMPath & "'Could not load '" & CONST_INPUTXMLFILEPATH & "' Properly. Error " & ObjXMLDoc.ParseError.Reason)
'**** -----> ParseMediaInfo = 4
Else
'*** XML Document has been read correctly
set objrootElement = objXMLDoc.documentElement
For each objNode in objRootElement.SelectNodes("MediaUrl")
TreatNode(objNode)
Next
End if
'*** Release objects...
set objXMLDOC = Nothing
set objNode = Nothing
End Function
Function TreatNode(objNode)
'*****************************************************
'*** Purpose: This procedure Update Tversity with the Right Information using the external command Mshare
'*** Inputs : objNode (XMLNODE Object) - Correspond to one node MediaURL
'*** Returns: True if success, False if failure
'*****************************************************
If (gDEBUG=0) Then On Error Resume Next
Dim objSchedule '*** XMLNODE Get the Schedule part of the Media
Dim strTitle '*** STRING Title of the Media URL
Dim strURL '*** STRING URL of the Media
Dim strURLType '*** STRING Type of URL (Video URL, Audio URL, etc.)
Dim strTags '*** STRING Tveristy Tags of the Media URL
Dim strPublic '*** STRING Public Flag (yes or no)
Dim strWeekDay '*** STRING WeekDay use to retrieve the date of the last URL update
Dim strLastUpdated '*** STRING Date of the last URL update
Dim dtLastDate '*** DATE Get the date of the last time the MediaURl is supposed to be updated
For each objSchedule in objNode.SelectNodes("Schedule")
'*** Assign Variables from XML value
strTitle = Objnode.getElementsByTagName("Title").Item(0).text
strTags = objNode.GetElementsByTagName("Tags").Item(0).Text
strURL = Objnode.getElementsByTagName("Url").Item(0).text
strURLType = Objnode.getElementsByTagName("Type").Item(0).text
strPublic = Objnode.getElementsByTagName("Public").Item(0).text
strWeekDay = objSchedule.GetElementsByTagName("WeekDay").Item(0).Text
strLastUpdated = objSchedule.GetElementsByTagName("LastUpdated").Item(0).Text
if (gDEBUG>=1) then Call WriteLog("DEBUG;" & strTitle & chr(10) & strTags & chr(10) & strURL & chr(10) & strUrlType & chr(10) & strPublic & chr(10) & strWeekDay & chr(10) & strLastUpdated)
dtLastDate = GetDateLastDayoftheWeek(strWeekDay)
if dtLastDate=False then
'**** Error getting the Last date
Call WriteLog("WARNING;'" & strTitle & "-" & strWeekDay & "' is skipped.")
Else
'**** Last date retrieved successfully --> update Tversity media library
'*** if strLastUpdate is a Null string assign the default date
If strLastUpdated="" then strLastUpdated="1901-01-01"
If DateDiff("d", Cdate(strLastUpdated), Cdate(dtLastDate))>0 Then
'*** Tversity has to be updated
if (gDEBUG>=1) then Call WriteLog("DEBUG;'" & strTitle & "-" & strWeekDay & "' Has to be updated!")
If CreateMediaUrl(strTitle,strTags,strUrl,strURLType,strPublic,dtLastDate)=True then
'*** Update succeeded. Update the XML document
objSchedule.GetElementsByTagName("LastUpdated").Item(0).Text = dtLastDate
objSchedule.ownerDocument.save(CONST_INPUTXMLFILEPATH)
Else
'*** Update failed
End if
Else
'*** Tversity already has the last update
if (gDEBUG>=1) then Call WriteLog("DEBUG;'" & strTitle & "-" & strWeekDay & "' is up to date!")
End if
End if
Next
'*** Release objects
set objSchedule = Nothing
End function
Function CreateMediaURL(ByVal strTitle, ByVal strTags, ByVal strURL, byVal strURLType, ByVal strPublic, ByVal dtLastDate)
'*****************************************************
'*** Purpose: This Function Use tveristy command line tool to update the tveristy database with the new MediaURL
'*** Inputs : All arguments are used to create the media URL in Tversity
'*** Returns: Return True if success. False if failure
'*****************************************************
dim objShell '*** WSH SHELL Shell object used to run the external command
dim strCommand '*** STRING Command to execute
dim objShellExec
dim intRunReturn '*** INTEGER Return code return by the program executed by the Run command
dim strCmdOutput '*** STRING Get the command return
set objShell = WScript.CreateObject("WScript.Shell")
'*** Replace the Title with the Right Date information
strTiTle = ReplaceMacros(strTitle,dtLastDate)
'*** Replace the URL with the Right Date information
strURL = ReplaceMacros(strURL,dtLastDate)
'*** Set the strURLType to be recognised by the Command mShare
Select Case UCASE(strURLType)
Case "VIDEO URL", "VIDEO"
strURLType = " -V "
Case "AUDIO URL", "AUDIO"
strURLType = " -A "
End Select
strCommand = "%comspec% /c Pushd " & chr(34) & CONST_TVERSITYPATH & chr(34) & " & Mshare -T " & chr(34) & strTitle & chr(34) & " -G " & chr(34) & strTags & chr(34) & strURLType & chr(34) & strURL
if (gDEBUG>=1) then Call WriteLog("DEBUG;strCommand is '" & strCommand & "'")
set objShellExec = objShell.Exec(strCommand)
Do While objShellExec.Status = 0
WScript.Sleep 100
Loop
strCmdoutput = "out:2" & objShellExec.stdout.ReadAll & "Err:" & objShellExec.stdErr.Readall
if instr(Ucase(strCmdOutPut), Ucase(CONST_SUCCESS_STRING)) then
'*** Update Successful
if (gDEBUG>=1) then Call WriteLog("INFO;Update successful. " & Replace(strCmdOutPut,chr(10),"\
"))
Call WriteURL(strURL)
CreateMediaURL=True
Else
'*** Update failure
Call WriteLog(“ERROR;Update failure. " & Replace(strCmdOutPut,chr(10),”
"))
CreateMediaURL=False
End if
'*** Release object
set objShell = Nothing
set objShellExec = Nothing
End Function
Function ReplaceMacros(strText, dtDate)
'*****************************************************
'*** Purpose: This Function Replace the macro in strText with their values
'*** Inputs : strText - String of text that contains the macro to be replaced
'*** dtDate - Date used to get the current value of the Macros
'*** Returns: Return a string where the macros has been replaced by their value
'*****************************************************
Dim strTextUpdated '*** STRING with the text updated by the macros
strTextUpdated = strText
'*** Replace year tags
strTextUpdated = Replace(strTextUpdated,"|4y|",year(dtDate))
strTextUpdated = Replace(strTextUpdated,"|2y|",Right(Year(dtDate),2))
'*** Replace Month tags
if Left(Month(dtDate),1)="0" or Len(Month(dtDate))=1 then
'*** Month number start by 0 (eg: January->01) or is only 1 position length (eg: January->1)
strTextUpdated = Replace(strTextUpdated,"|1m|",Right(Month(dtDate),1)) '*** Remove leading 0
strTextUpdated = Replace(strTextupdated,"|2m|","0" & Month(dtDate)) '*** Add leading 0
Else
strTextUpdated = Replace(strTextUpdated,"|1m|",Month(dtDate))
strTextUpdated = Replace(strTextupdated,"|2m|",Month(dtDate))
End if
'*** Replace Day tags
if Left(Day(dtDate),1)="0" or Len(Day(dtDate))=1 then
'*** Day number start by 0 (eg: 01) or is only 1 position length (1)
strTextUpdated = Replace(strTextUpdated,"|1d|",Right(Day(dtDate),1)) '*** Remove leading 0
strTextUpdated = Replace(strTextupdated,"|2d|","0" & Day(dtDate)) '*** Add leading 0
Else
strTextUpdated = Replace(strTextUpdated,"|1d|",Day(dtDate))
strTextUpdated = Replace(strTextupdated,"|2d|",Day(dtDate))
End if
ReplaceMacros = strTextUpdated
End Function
Function GetDateLastDayoftheWeek(strWeekDay)
'*****************************************************
'*** Purpose: This Function return the Date of the Last day of week (eg: Last monday)
'*** Inputs : strWeekDay => week day for which we want to get the last date (monday, Tuesday, Wednesday=3)
'*** Returns: If strweekDay is valide–> DateSerial of the day else return False
'*****************************************************
Dim intDayNumber '*** INTEGER Day number corresponding at strWeekDay
Dim intDayNumberNow '*** INTEGER Get the weekday of today
Dim intDayDelta '*** INTEGER Number of day between now and the date
'*** Get the Day number of strWeekDay
Select Case lcase(strWeekDay)
Case "monday","lundi"
intDayNumber = 1
Case "tuesday","mardi"
intDayNumber = 2
Case "wednesday","mercredi"
intDayNumber = 3
case "thursday","jeudi"
intDayNumber = 4
Case "friday","vendredi"
intDayNumber = 5
Case "saturday","samedi"
intDayNumber = 6
Case "sunday","dimanche"
intDayNumber = 7
Case Else
Call WriteLog("ERROR;'" & strWeekDay & "' is not a day with a valid name.")
GetDateLastDayofTheWeek=False
End Select
'*** Get the day number of today
intDayNumberNow=WeekDay(Now,gFirstDayofTheWeek)
intDayDelta = intDayNumberNow - intDayNumber
if intDayDelta>=0 then
GetDateLastDayofTheWeek = DateSerial(year(Now), month(Now), day(Now)-intDayDelta)
Else
GetDateLastDayofTheWeek = DateSerial(year(Now), month(Now), day(Now)-(7+intDayDelta))
End if
if (gDEBUG>=1) then Call WriteLog("DEBUG;dtLastDate for '" & strWeekDay & "(" & intDayNumber & ") is '" & GetDateLastDayofTheWeek & "'")
End Function
Function CheckXMLFile(strXMLFilePath)
'*****************************************************
'*** Purpose: This procedure Verify if the XML file exist and his in good shape. in the file system and create it if required.
'*** Inputs : Path of the XML file to test
'*** Returns: True if success, False if failure
'*****************************************************
If (gDEBUG=0) Then On Error Resume Next
Dim strXMLFilePathCopy '*** STRING Path of copy of the XML file in case of we have to rebuild it.
Dim objXMLDoc '*** XML OBJECT Document Object corresponding to the STATE FILE
'*** instantiate XMLDoc Object
set objXMLDoc=CreateObject("Microsoft.XMLDOM")
If (gobjFSO.FileExists(strXMLFilePath)) Then
'*** File Exist, test if it's a Good XML File
'*** Load XML File in Memory
objXMLDoc.async="false"
objXMLDoc.load(strXMLFilePath)
'*** Test if XML file could be read properly
if objXMLDoc.parseError.ErrorCode <> 0 then
'*** Error during reading of the XML Document
Call WriteLog("ERROR;'CheckXMLFile' Could not load '" & strXMLFilePath & "' Properly. Error " & ObjXMLDoc.ParseError.Reason)
'*** Delete the File and recreate a New one.
strXMLFilePathCopy = strXMLFilePath & " - File not correct - "
Call gobjFso.CopyFile(strXMLFilePath, strXMLFilePathCopy, true)
if Err.Number <> 0 then
'*** Error Copying file
Call WriteLog("WARNING;Error during copy of '" & strXMLFilePath & "' to '" & strXMLFilePathCopy & "'. Error: " & Err.Description)
End if
'*** Delete Current XML File
Call gobjFso.DeleteFile(strXMLFilePath)
if Err.Number <> 0 then
'*** Error deleting file
Call WriteLog("WARNING;Error during deletion of '" & strXMLFilePath & "'. Error: " & Err.Description)
End if
'*** Create a new Template
objXMLDoc.LoadXML("<?xml version=""1.0"" encoding=""utf-8""?><Tversity><MediaUrl><Url>http://myUrl.example</Url><Title>My Title |2y||2m||2d|</Title><Tags>OnDemandTV.MyProgram</Tags><Public>Yes</Public><Type>Video URL</Type><Schedule><WeekDay>Monday</WeekDay><LastUpdated></LastUpdated></Schedule><Schedule><WeekDay>Tuesday</WeekDay><LastUpdated></LastUpdated></Schedule></MediaUrl></Tversity>")
objXMLDoc.Save(strXMLFilePath)
'*** Test if new if is correct.
if objXMLDoc.parseError.ErrorCode <> 0 then
'*** Error during reading of the XML Document
Call WriteLog("ERROR;'CheckXMLFile' To Create a New '" & strXMLFilePath &"' Log file. Error: " & Err.Description)
CheckXMLFile=False
Else
Call WriteLog("INFO;'CheckXMLFile' created '" & strXMLFilePath & "' successfully!")
CheckXMLFile=True
End if
Else
'*** Nothing to Do file is correct
if (gDEBUG>=1) then WriteLog("DEBUG;'" & strXMLFilePath & "' exist and is a valid XML File!")
CheckXMLFile=True
End if
Else
'*** File Does Not Exist Create a new one.
objXMLDoc.LoadXML("<VMState></VMState>")
objXMLDoc.Save(strXMLFilePath)
'*** Test if new if is correct.
if objXMLDoc.parseError.ErrorCode <> 0 then
'*** Error during reading of the XML Document
Call WriteLog("ERROR;'CheckXMLFile' To Create a New '" & strXMLFilePath &"' Log file. Error: " & Err.Description)
CheckXMLFile=False
Else
Call WriteLog("INFO;'CheckXMLFile' created '" & strXMLFilePath & "' successfully!")
CheckXMLFile=True
End if
End if
set objXMLDoc = Nothing
End Function
Sub WriteLog(strData)
'*****************************************************
'*** Purpose: This procedure write log into a file
'*** Inputs : String of data to write on the file (only one line)
'*** gobjFso must be declared as global variable and initialized
'*** Returns: Nothing
'*****************************************************
If (gDEBUG=0) Then On Error Resume Next
Dim strLogFile '*** STRING Contains Path of the log files
Dim tsLogFile '*** FileSystem Object Object TextStream to manage files data
Dim objLogFile '*** FileSystem Object Object for the log files
'*** if DEBUG mode is activated... Print message on the console.
'if (gDEBUG=1) then wscript.echo strData
strLogFile=replace(wscript.ScriptFullName, ".vbs",".log")
If (Not gobjFso.FileExists(strLogFile)) Then
'*** File doesn't exist -> create and write
Call gobjFso.CreateTextFile(strLogFile, True)
Else
'*** File Exist -> open and Write
objLogFile=gobjFso.GetFile(strLogFile)
End If
'*** Create TextStream for file append (8) and ascii (0) mode
Set tsLogFile=gobjFso.OpenTextFile(strLogFile,8, False)
'*** Write Data on the file
tsLogFile.Writeline(now & ";" & strData)
tsLogFile.Close
End Sub
Sub WriteURL(strData)
'*****************************************************
'*** Purpose: This procedure write log into a file
'*** Inputs : String of data to write on the file (only one line)
'*** gobjFso must be declared as global variable and initialized
'*** Returns: Nothing
'*****************************************************
If (gDEBUG=0) Then On Error Resume Next
Dim strLogFile '*** STRING Contains Path of the log files
Dim tsLogFile '*** FileSystem Object Object TextStream to manage files data
Dim objLogFile '*** FileSystem Object Object for the log files
'*** if DEBUG mode is activated... Print message on the console.
'if (gDEBUG=1) then wscript.echo strData
strLogFile=replace(wscript.ScriptFullName, ".vbs","-URLs.txt")
If (Not gobjFso.FileExists(strLogFile)) Then
'*** File doesn't exist -> create and write
Call gobjFso.CreateTextFile(strLogFile, True)
Else
'*** File Exist -> open and Write
objLogFile=gobjFso.GetFile(strLogFile)
End If
'*** Create TextStream for file append (8) and ascii (0) mode
Set tsLogFile=gobjFso.OpenTextFile(strLogFile,8, False)
'*** Write Data on the file
tsLogFile.Writeline(strData)
tsLogFile.Close
End Sub