' Converts any video file (or a folder full of files) 
' to MP4 H264. If a file or folder is not specfied, the 
' script will offer to set up (or remove) right-click 
' access to this script for any desired file type.

Option Explicit

' REQUIRES "ffmpeg.exe" (and "pthreadGC2.dll") best obtained by installing
' Videora iPod converter from: http://www.videora.com/ then copying files.
' Ffmpeg needs H264 option compiled in, which is fairly rare. See also:
' http://sourceforge.net/project/showfiles.php?group_id=205275&package_id=248632
' http://ffdshow.faireal.net/mirror/ffmpeg/
' http://www.videohelp.com/tools/ffmpeg
' 
' If available in the %PATH%, will use the ActiveX or command-line version 
' of "MediaInfo"to get movie or show data. See http://mediainfo.sourceforge.net.
'
' If available in the %PATH%, will use "ExtractClosedCaptions.exe" 
' (and Toub.MediaCenter.Dvrms.dll) to get captions from ms-dvr files. See:
' http://ericphelps.com/scripting/samples/2Phone/index.html
'
' If available in the %PATH%, will use "MP4Box.exe" to add subtitles 
' directly to the MP4 file. See:
' http://kurtnoise.free.fr/mp4tools/
'
' If available in the %PATH%, will use "AtomicParsley.exe" to 
' add metadata to the MP4 file. See:
' http://sourceforge.net/projects/atomicparsley
'
' FFDSHOW required to permanently embed subtitles from
' http://sourceforge.net/projects/ffdshow-tryout/
'
' AVISynth required to permanently embed subtitles from
' http://avisynth.org/
'
'
' If an Internet connection is available, will parse information 
' from http://www.imdb.com/ to get movie plot and release year data.
' as a backup (preference is to use embedded file data)
'
' MP4 files will play on Windows Mobile using TCPMP from:
' http://picard.exceed.hu/tcpmp/test/
' MP4 files will play on Windows. Try these players:
' http://www.videolan.org/
' http://mpui.sourceforge.net/

' In addition to the trivial task of converting videos, this script
' attempts to organize the videos. Because my input files mostly come from 
' Windows Media Center or DVR2WMV, I've written the script to accept
' those input naming conventions. Files are automatically renamed and 
' placed in the correct output folder. For example:
' "Painkiller Jane - What Lies Beneath.wmv" would go in a "PainkillerJane" folder and be named "WhatLiesBeneath.mp4"
' "Das Boot_AMC_06_09_2007_06_00_02.dvr-ms" would go in a "Movies" folder and be called "DasBoot.mp4"

'These variables used to be constants, but when I allowed reading them 
'in from an external file, it became easier to make them variables
Dim BASE_FOLDER, MOVIES_SUBFOLDER, CONVERTER_EXE, COMMAND_LINE
Dim OUTPUT_EXTENSION, FILE_EXTENSIONS, SUBTITLE_EXTENSIONS, VERBOSE
Dim SRT_SUBTITLE_DEFAULT_MAX_TIME, SMI_TIMING_CORRECTION
Dim WAIT_FOR, PERMANENT_SUBTITLES, PERMANENT_SUBTITLES_SIZE, LOGGING
Dim DELETE_SOURCE_FILES 

'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'  NOTE: The default settings below will be ignored in favor of 
'  values in the external INI file. An external INI file will 
'  offer to be created if it doesn't exist (unless it can't be!).
'  If you don't want external file settings and don't want To
'  be asked to confirm settings, create a dummy INI file (zero 
'  bytes or nothing but comments).
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

'Videos will be placed in a subfolder under BASE_FOLDER. 
'Failsafe to "My Documents" or "My Videos" or "My Movies" if BASE_FOLDER does not exist
BASE_FOLDER = "E:\Video"
'If a series name can't be deduced, place the output in this subfolder. It will be created if needed.
MOVIES_SUBFOLDER = "Movies"
'Specify the full path to the converter if it isn't in your PATH
CONVERTER_EXE = "ffmpeg.exe"
'Run this command to do the actual conversion. The ALL_CAPS text will be replaced later.
COMMAND_LINE = "CONVERTER_EXE -i INPUT -loop 1 -f mp4 -s 320x240 -r 15 -vcodec libx264 -level 13 -vb 100k -g 75 -coder 0 -threads auto -acodec libfaac -ac 1 -ab 16k -async 2 -title MOVIE_TITLE -comment MOVIE_DESCRIPTION OUTPUT"
'To discourage multiple instances, wait for these programs to finish
WAIT_FOR = "ffmpeg.exe ExtractClosedCa"
'Output file will have (more or less) the same name as input except for this file extension
OUTPUT_EXTENSION = ".mp4"
'If you process an entire folder, what source file types should you process?
FILE_EXTENSIONS = "dvr-ms.avi.wmv.asf.mpg.mp4.m4v.mpeg"
'Subtitle or other associated files in order of desirability
SUBTITLE_EXTENSIONS = "srt.sub.idx.smi"
'Control how chatty the script will be
VERBOSE = True
'If VERBOSE is True, would you also like all messages logged?
LOGGING = False
'Limits on-screen subtitle times in SRT files generated by "ExtractClosedCaptions.exe" 
SRT_SUBTITLE_DEFAULT_MAX_TIME = 3
'Corrects SMI files produced by DVR2WMV (those files have subtitles appear several seconds early)
SMI_TIMING_CORRECTION = 0
'Do you want hard-coded permanent subtitles (if you have AVISynth and FFDSHOW)?
PERMANENT_SUBTITLES = True
'If you have permanent subtitles, how big should they be
PERMANENT_SUBTITLES_SIZE = 36
'Should source files be deleted?
DELETE_SOURCE_FILES = True

'If run with no arguments, offer to toggle right-click shortcut
If WScript.Arguments.Count <> 1 Then
	ToggleRightClick(InputBox("Enter file extension to toggle right-click support for", "Right-Click Registration", ".dvr-ms"))
	WScript.Quit
End If

'If a settings file exists, use it instead of the above default constants
Dim dic, strName, strValue
If CreateObject("Scripting.FileSystemObject").FileExists(FileNameLikeMine("ini")) Then
	'Settings file exists. Read it in.
	Set dic = FileToDictionary(FileNameLikeMine("ini"))
	For Each strName In Split("BASE_FOLDER MOVIES_SUBFOLDER CONVERTER_EXE COMMAND_LINE WAIT_FOR OUTPUT_EXTENSION FILE_EXTENSIONS SUBTITLE_EXTENSIONS VERBOSE LOGGING SRT_SUBTITLE_DEFAULT_MAX_TIME SMI_TIMING_CORRECTION PERMANENT_SUBTITLES DELETE_SOURCE_FILES PERMANENT_SUBTITLES_SIZE")
		If dic.Exists(strName) Then
			Execute  strName & " = " & dic(strName)
		End If
	Next
Else
	'Correct the BASE_FOLDER if it doesn't exist
	BASE_FOLDER = CreateObject("Scripting.FileSystemObject").GetParentFolderName(CreateObject("Scripting.FileSystemObject").GetParentFolderName(OutputFilePath(WScript.Arguments(0))))
	'Put the internal script settings into a dictionary
	Set dic = CreateObject("Scripting.Dictionary")
	For Each strName In Split("BASE_FOLDER MOVIES_SUBFOLDER CONVERTER_EXE COMMAND_LINE WAIT_FOR OUTPUT_EXTENSION FILE_EXTENSIONS SUBTITLE_EXTENSIONS VERBOSE LOGGING SRT_SUBTITLE_DEFAULT_MAX_TIME SMI_TIMING_CORRECTION PERMANENT_SUBTITLES PERMANENT_SUBTITLES_SIZE DELETE_SOURCE_FILES")
		If TypeName(Eval(strName)) = "String" Then
			dic.Add strName, """" & Eval(strName) & """"
		Else
			dic.Add strName, Eval(strName)
		End If
	Next
	'Since no INI file exists, confirm the current settings and offer to save them as an INI file
	If DictionaryGUI(dic) Then
		DictionaryToFile dic, FileNameLikeMine("ini")
	End If
	'Assume  the settings were changed. Save them all
	DictionaryExecute(dic)
End If

'Release the settings dictionary now that we're completely done with it
Set dic = Nothing

'Declare a glogal dictionary for IMDB data
Dim gdicImdbData
Set gdicImdbData = Nothing

'Wait for other programs defined in WAIT_FOR
WaitFor
Main

Sub Main
Dim strInputFolder, strInputFile, strOutputFile, strFlagFile, fol, fs, ws
	Set fs = CreateObject("Scripting.FileSystemObject")
	Set ws = CreateObject("WScript.Shell")
	strInputFolder = WScript.Arguments(0)
	If fs.FolderExists(strInputFolder) Then
		'The "strInputFolder" is the expected folder. Go ahead and process the files in it
		ProcessFolder fs.GetFolder(strInputFolder)
		Exit Sub
	End If
	If Not fs.FileExists(strInputFolder) Then
		'We didn't get a folder or a file
		MsgBox "The folder or file """ & strInputFile & """ does not exist."
		Exit Sub
	End If
	'The "strInputFolder" we got is actually a file name!
	'Assign a new name to make the code more readable
	strInputFile = strInputFolder
	
	'Make sure we will be working with the long file name
	If VERBOSE Then Status "INPUT FILE: " & strInputFile
	strInputFile = LongName(strInputFile)
	If VERBOSE Then Status "INPUT FILE: " & strInputFile

	'Only copy and process one file at a time
	strOutputFile = fs.BuildPath(fs.GetParentFolderName(OutputFilePath(strInputFile)), fs.GetFileName(strInputFile))
	strFlagFile = fs.BuildPath(fs.GetParentFolderName(OutputFilePath(strInputFile)), fs.GetBaseName(WScript.ScriptName) & ".flag")
	Do Until Not(fs.FileExists(strFlagFile))
		If VERBOSE Then Status "Waiting for other process to finish " & Now()
		WScript.Sleep (Int(299 * Rnd + 30)) * 1000
	Loop
	fs.CreateTextFile strFlagFile, False
	
	'If this is a UNC network file, try to copy it to the local drive
	If Left(strInputFile, 2) = "\\" Then
		If VERBOSE Then Status "COPYING: """ & strInputFile & """ to """ & strOutputFile & """"
		'ws.Run "robocopy.exe " & """" & strInputFile & """ """ & strOutputFile & """"
		fs.CopyFile strInputFile, strOutputFile, False
		If fs.FileExists(strOutputFile) Then
			If fs.GetFile(strOutputFile).Size = fs.GetFile(strInputFile).Size Then
				If VERBOSE Then Status "COPIED: """ & strInputFile & """ to """ & strOutputFile & """"
				If DELETE_SOURCE_FILES Then
					If VERBOSE Then Status "DELETING: """ & strInputFile & """"
				End If
				RecycleFile strInputFile
				strInputFile = strOutputFile
			Else
				'Bad file copy. Delete the bad copy and proceed with the original.
				If DELETE_SOURCE_FILES Then
					If VERBOSE Then Status "BAD COPY -- DELETING: """ & strOutputFile & """"
				End If
			End If
		End If
	End If
	
	'Do the file conversion
	strOutputFile = ProcessFile(fs.GetFile(strInputFile))
	'Add the subtitles and whatnot
	If strOutputFile <> "" Then PostProcess strInputFile, strOutputFile
	'Remove the flag to allow another process to start
	If fs.FileExists(strFlagFile) Then fs.DeleteFile strFlagFile
	'Delete the original movie source file
	If DELETE_SOURCE_FILES Then 
		If fs.FileExists(strInputFile) Then
			If VERBOSE Then Status "DELETING " & strInputFile 
			RecycleFile strInputFile
		End If
	End If
End Sub

Sub ProcessFolder(objFolder)
Dim fs, filsInput, filInput, folsInput, folInput, strInputFile, strOutputFile
	Set fs = CreateObject("Scripting.FileSystemObject")
	On Error Resume Next
	'Get each file in turn
	Set filsInput = objFolder.Files
	If Err.Number <> 0 Then Exit Sub
	For Each filInput In filsInput
		strInputFile = filInput.Path
		'Only process files of the desired type
		If InStr(FILE_EXTENSIONS, fs.GetExtensionName(strInputFile)) <> 0 Then
			Status ""
			'Process the file
			strOutputFile = ProcessFile(filInput)
			Set filInput = Nothing
			If strOutputFile <> "" Then PostProcess strInputFile, strOutputFile
		Else
			Status "IGNORING: " & filInput.Name
		End If
	Next
End Sub

Function ProcessFile(fil)
'Creates new version of video in destination. Returns output video file path.
'Moves (Copies and deletes) SMI file to destination
Const WshNormalFocus = 1
Const WshMinimizedNoFocus = 7
Const TemporaryFolder = 2
Dim ws, fs, strDestFolder, strDestName, strSourceName, strCommand
Dim strMovieTitle, strMovieDescription, strMovieReleaseDate, strWaitFor
Dim blnRunning, objWMIService, colItems, objItem, lngDelay, strSrtFile
Dim strAvsFile
	Set ws = CreateObject("Wscript.Shell")
	Set fs = CreateObject("Scripting.FileSystemObject")
	
	'Wait for other programs defined in WAIT_FOR
	WaitFor

	strDestName = OutputFilePath(fil.Path)
	
	'If subtitle files exist, move them to the destination folder
	SubtitleFileMove fil.Path, strDestName
	
	'Bail out if the destination file already exists
	If fs.FileExists(strDestName) Then
		Status "SKIPPING: " & strDestName
		If DELETE_SOURCE_FILES Then
			If VERBOSE Then Status "DELETING: " & fil.Path
			RecycleFile fil.Path
		End If
		ProcessFile = ""
		Exit Function
	End If
	
	'Create the AVS file so we can hard-embed subtitles
	strAvsFile = MakeAVSFile(fil.Path, fs.GetBaseName(strDestName), fs.GetParentFolderName(strDestName))
	If VERBOSE Then 
		If strAvsFile = "" Then
			If VERBOSE Then Status "AVS file creation not enabled or not possible"
		Else
			If VERBOSE Then Status "AVS file created: " & strAvsFile
		End If
	End If
	
	'We'll need subtitles early if we have to hard-embed them
	If strAvsFile <> "" Then
		'Wait for other programs defined in WAIT_FOR
		WaitFor
		'Make the subtitles
		strSrtFile = MovieSubTitleFile(fil.Path, fs.BuildPath(fs.GetParentFolderName(strDestName), fs.GetBaseName(strDestName) & ".srt"))
		If strSrtFile <> "" Then
			fs.CopyFile strSrtFile, fs.BuildPath(fs.GetParentFolderName(strDestName), fs.GetBaseName(fil.Path) & ".srt")
		End If
		'Set up the FFDSHOW registry to insure subtitles are on (we never undo this)
		ws.RegWrite "HKCU\Software\GNU\ffdshow\default\fontColor", RGB(255, 255, 255), "REG_DWORD"
		ws.RegWrite "HKCU\Software\GNU\ffdshow\default\fontSize", PERMANENT_SUBTITLES_SIZE, "REG_DWORD"
		ws.RegWrite "HKCU\Software\GNU\ffdshow\default\isSubtitles", 1, "REG_DWORD"
	End If
	
	'If we don't have subtitles, then there's no point in having an AVS file
	If strSrtFile = "" Then
		If strAvsFile <> "" Then
			If fs.FileExists(strAvsFile) Then
				If VERBOSE Then Status "No subtitle file! Deleting unneeded AVS file."
				fs.DeleteFile strAvsFile 
			End If
			strAvsFile = ""
		End If
	End If
	
	'Wait for other programs defined in WAIT_FOR
	WaitFor
	'Try to find movie title
	strMovieTitle = MovieTitle(fil.Path)
	'Now that we know the title, get all the IMDB data on the movie
	If gdicImdbData Is Nothing Then Set gdicImdbData = CreateDictionaryIMDB(strMovieTitle)
	'Wait for other programs defined in WAIT_FOR
	WaitFor
	'Find the movie plot description
	strMovieDescription = MovieDescription(fil.Path, strMovieTitle)
	'Wait for other programs defined in WAIT_FOR
	WaitFor
	'Convert the video file
	strCommand = COMMAND_LINE
	strCommand = Replace(strCommand, "CONVERTER_EXE", CONVERTER_EXE)
	If strAvsFile = "" Then
		strCommand = Replace(strCommand, "INPUT", """" & fil.Path & """")
	Else
		strCommand = Replace(strCommand, "INPUT", """" & strAvsFile & """")
	End If
	strCommand = Replace(strCommand, "OUTPUT", """" & strDestName & """")
	strCommand = Replace(strCommand, "MOVIE_TITLE", """" & Replace(strMovieTitle, """", "") & """")
	strCommand = Replace(strCommand, "MOVIE_DESCRIPTION", """" & Replace(strMovieDescription, """", "") & """")
	If VERBOSE Then 
		Status "RUNNING: " & strCommand
	Else
		Status "CONVERTING MOVIE ..."
	End If
	ws.Run strCommand, WshMinimizedNoFocus, True
	
	'If we used AVISynth, we likely lost the audio. Put it back in.
	If strAvsFile <> "" Then
		'Extract the audio stream as a separate file
		strCommand = CONVERTER_EXE & " -i " & """" & fil.Path & """"
		strCommand = strCommand & " -acodec libfaac -ac 1 -ab 16k " & """"
		strCommand = strCommand & fs.BuildPath(fs.GetParentFolderName(strDestName), fs.GetBaseName(strDestName) & ".aac")
		strCommand = strCommand & """"
		If VERBOSE Then Status "Running " & strCommand
		ws.Run strCommand, WshMinimizedNoFocus, True
		'Wait for antivirus to pass file
		WScript.Sleep 500
		'Insert the audio stream into the MP4 output file
		strCommand = "MP4Box.exe -tmp" & " " & """" & fs.GetSpecialFolder(TemporaryFolder) & """"
		strCommand = strCommand & " " & "-add"
		strCommand = strCommand & " " & """" & fs.BuildPath(fs.GetParentFolderName(strDestName), fs.GetBaseName(strDestName) & ".aac") & """"
		strCommand = strCommand & " " & """" & strDestName & """"
		If VERBOSE Then Status "Running " & strCommand
		ws.Run strCommand, WshMinimizedNoFocus, True
	End If

	'Clean up
	If DELETE_SOURCE_FILES Then 
		RecycleFile fs.BuildPath(fs.GetParentFolderName(strDestName), fs.GetBaseName(strDestName) & ".aac")
		RecycleFile strAvsFile
	End If
	
	'Return the destination file name
	ProcessFile = strDestName
End Function

Sub WaitFor()
Dim blnRunning, strWaitFor, objWMIService, objItem, colItems, lngDelay 
	'Don't start if another instance of the converter is running
	blnRunning = True
	Do While blnRunning = True
		blnRunning = False
		For Each strWaitFor In Split(WAIT_FOR, " ")
			Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
			Set colItems = objWMIService.ExecQuery("Select Name from Win32_Process where Name='" & strWaitFor & "'",,48)
			For Each objItem in colItems
				blnRunning = True
				Status "Waiting for " & strWaitFor & " " & Now()
			Next
			'Wait a random time
			If blnRunning Then
				Randomize
				lngDelay = Int(299 * Rnd + 30)
				WScript.Sleep lngDelay * 1000
			End If
		Next
	Loop
End Sub

Sub PostProcess(strInputFile, strOutputFile)
'Things to do after the file has been converted.
Dim fs, strMovieDescription, strMovieReleaseDate, strMovieSubtitleFile
Dim ws, strCommand, strMovieTitle, strYear
Const WshNormalFocus = 1
Const WshMinimizedNoFocus = 7
Const TemporaryFolder = 2
	Set fs = CreateObject("Scripting.FileSystemObject")
	Set ws = CreateObject("Wscript.Shell")
	'Check for an apparently good output file
	If fs.FileExists(strOutputFile) Then
		'Check for reasonable output file size
		If (fs.GetFile(strOutputFile).Size > (fs.GetFile(strInputFile).Size / 30)) Then
			'At this point, we probably have a good output file.
			If VERBOSE Then Status "GOOD OUTPUT FILE"
			'This only works on MP4 files.
			If fs.GetExtensionName(strOutputFile) = "mp4" Then
				strMovieTitle = MovieTitle(strInputFile)
				strMovieDescription = MovieDescription(strInputFile, strMovieTitle)
				strMovieReleaseDate = MovieReleaseDate(strInputFile, strMovieTitle)
				strMovieSubtitleFile = MovieSubtitleFile(strInputFile, strOutputFile)
				'Try to make it more iPod compatible (still works on Windows)
				strCommand = "MP4Box.exe -tmp" & " " & """" & fs.GetSpecialFolder(TemporaryFolder) & """"
				strCommand = strCommand & " " & "-ipod"
				strCommand = strCommand & " " & """" & strOutputFile & """"
				If VERBOSE Then Status "RUNNING: " & strCommand
				ws.Run strCommand, WshMinimizedNoFocus, True
				'Add the subtitles
				If strMovieSubtitleFile <> "" Then
					'mp4box.exe -add test.mpg#video -add test.mpg#audio -add test.srt test.mp4
					strCommand = "MP4Box.exe -tmp" & " " & """" & fs.GetSpecialFolder(TemporaryFolder) & """"
					strCommand = strCommand & " " & "-add"
					strCommand = strCommand & " " & """" & strMovieSubtitleFile & """"
					strCommand = strCommand & " " & """" & strOutputFile & """"
					If VERBOSE Then 
						Status "RUNNING: " & strCommand
					Else
						Status "ADDING SUBTITLES ..."
					End If
					ws.Run strCommand, WshMinimizedNoFocus, True
				End If
				'Add the movie metadata
				strCommand = "AtomicParsley.exe" & " " & """" & strOutputFile & """"
				strCommand = strCommand & " --overWrite"
				strCommand = strCommand & " --description " & """" & Replace(strMovieDescription, """", "") & """"
				strCommand = strCommand & " --year " & """" & strMovieReleaseDate & """"
				strCommand = strCommand & " --genre " & """" & MovieGenre(strInputFile, strMovieTitle) & """"
				strCommand = strCommand & " --artist " & """" & "" & """"
				strCommand = strCommand & " --encodingTool " & """FFMPEG <ffdshow.faireal.net/mirror/ffmpeg> MediaInfo <mediainfo.sourceforge.net> MP4Box <kurtnoise.free.fr/mp4tools> AtomicParsley <atomicparsley.sourceforge.net> FFDSHOW <ffdshow-tryout.sourceforge.net> AVISynth <avisynth.org>"""
				If VERBOSE Then 
					Status "RUNNING: " & strCommand
				Else
					Status "ADDING METADATA ..."
				End If
				ws.Run strCommand, WshMinimizedNoFocus, True
			End If
			If DELETE_SOURCE_FILES Then
				If VERBOSE Then Status "DELETING: " & strInputFile
				RecycleFile strInputFile
				'If VERBOSE Then Status "DELETING: " & strMovieSubtitleFile
				'RecycleFile strMovieSubtitleFile
			End If
		Else
			Status "BAD OUTPUT FILE: " & strOutputFile
		End If
	End If
End Sub

Function OutputFilePath(strInputFile)
Dim strBaseFolder, fol, strDestFolder, strDestName, fs
	Set fs = CreateObject("Scripting.FileSystemObject")
	'Failsafe in case BASE_FOLDER does not exist because of unedited script
	If fs.FolderExists(BASE_FOLDER) Then
		strBaseFolder = BASE_FOLDER
	Else
		If VERBOSE Then Status "BASE FOLDER: " & BASE_FOLDER & " does not exist"
		strBaseFolder = CreateObject("Wscript.Shell").SpecialFolders("MyDocuments")
		For Each fol In fs.GetFolder(strBaseFolder).SubFolders
			If fol.Name = "My Movies" Then
				strBaseFolder = fol.Path
				Exit For
			End If
			If fol.Name = "My Videos" Then
				strBaseFolder = fol.Path
				Exit For
			End If
		Next
		If VERBOSE Then Status "CHANGED OUTPUT FOLDER TO: " & strBaseFolder
	End If
	'Try to figure out where to put the completed file. For example, 
	'"Painkiller Jane - What Lies Beneath.wmv" would go in the "PainkillerJane" folder.
	If InStr(fs.GetBaseName(strInputFile), " - ") = 0 Then
		strDestFolder = fs.BuildPath(strBaseFolder, MOVIES_SUBFOLDER)
	Else
		strDestFolder = fs.BuildPath(strBaseFolder, RemoveSpaces(Left(fs.GetBaseName(strInputFile), InStr(fs.GetBaseName(strInputFile), " - ") - 1)))
	End If
	If Not fs.FolderExists(strDestFolder) Then
		fs.CreateFolder strDestFolder
	End If
	'Make a no-spaces file name for the output. For example, 
	'"Painkiller Jane - What Lies Beneath.wmv" would be called "WhatLiesBeneath.mp4"
	'"Das Boot_AMC_06_09_2007_06_00_02.dvr-ms" would be called "DasBoot.mp4"
	If InStr(fs.GetBaseName(strInputFile), " - ") = 0 Then
		If fs.GetExtensionName(strInputFile) = "dvr-ms" And InStr(fs.GetBaseName(strInputFile), "_") <> 0 Then
			strDestName = Left(fs.GetBaseName(strInputFile), InStr(fs.GetBaseName(strInputFile), "_") - 1)
			strDestName = RemoveSpaces(strDestName)
			strDestName = fs.BuildPath(strDestFolder, strDestName & OUTPUT_EXTENSION)
		Else
			strDestName = fs.BuildPath(strDestFolder, fs.GetBaseName(RemoveSpaces(fs.GetBaseName(strInputFile))) & OUTPUT_EXTENSION)
		End If
	Else
		strDestName = Mid(fs.GetBaseName(strInputFile), InStr(fs.GetBaseName(strInputFile), " - ") + 3)
		strDestName = RemoveSpaces(strDestName)
		strDestName = fs.BuildPath(strDestFolder, fs.GetBaseName(strDestName) & OUTPUT_EXTENSION)
	End If
	If VERBOSE Then Status "OUTPUT FILE: " & strDestName
	OutputFilePath = strDestName
End Function

Sub SubtitleFileMove(strInputMovie, strOutputMovie)
'Insures all subtitle files (if any exists) have been MOVED to the output movie folder
'Converts any existing SMI files to SRT so they can be embedded in the movie later
Const WshNormalFocus = 1
Const WshMinimizedNoFocus = 7
Dim fs, ws, strSubtitleExtension, strCommand
	Set fs = CreateObject("Scripting.FileSystemObject")
	Set ws = CreateObject("Wscript.Shell")
	'Check each possible subtitle file
	For Each strSubtitleExtension In Split(SUBTITLE_EXTENSIONS, ".") 
		'Check to see if the source file exists
		If fs.FileExists(FileNameRelated(strInputMovie, strSubtitleExtension)) Then
			'Check to see if a subtitle file already exists in the output folder
			If fs.FileExists(FileNameRelated(strOutputMovie, strSubtitleExtension)) Then
				If VERBOSE Then Status "SUBTITLE SKIPPING: " & FileNameRelated(strOutputMovie, strSubtitleExtension)
			Else
				If VERBOSE Then Status "SUBTITLE COPYING TO: " & FileNameRelated(strOutputMovie, strSubtitleExtension)
				fs.CopyFile FileNameRelated(strInputMovie, strSubtitleExtension), FileNameRelated(strOutputMovie, strSubtitleExtension)
				'Now check to see if there is an SMI subtitle file we've just copied
				If strSubtitleExtension = "smi" Then
					WScript.Sleep 2000 'Wait for antivirus to allow file system access?
					If fs.FileExists(FileNameRelated(strOutputMovie, "smi")) Then
						'First fix the timimg on the SMI file
						If VERBOSE Then Status "SUBTITLE SMI FILE ADJUSTING TIMING BY " & SMI_TIMING_CORRECTION & " SECONDS"
						SubtitleSmiTimimgAdjust FileNameRelated(strOutputMovie, "smi")
						'Wait for antivirus to allow file system access?
						WScript.Sleep 2000 
						'Now convert the file to an SRT file (so we can embed it later)
						If Not fs.FileExists (FileNameRelated(strOutputMovie, "srt")) Then
							If VERBOSE Then Status "SUBTITLE CONVERTING SMI FILE TO SRT: " & FileNameRelated(strOutputMovie, "srt")
							String2File SubtitleSmi2Srt(FileNameRelated(strOutputMovie, "smi") ), FileNameRelated(strOutputMovie, "srt") 
						End If
					End If
				End If
			End If
			'Delete the source SMI file if the destination exists
			If fs.FileExists(FileNameRelated(strOutputMovie, strSubtitleExtension)) Then
				If DELETE_SOURCE_FILES Then 
					If VERBOSE Then Status "SUBTITLE DELETING: " & FileNameRelated(strInputMovie, strSubtitleExtension)
					RecycleFile FileNameRelated(strInputMovie, strSubtitleExtension)
				End If
			End If
		End If
	Next	
End Sub

Function MovieTitle(strFile)
'Returns a likely movie title from a filename input.
Dim fs, strMovieTitle
	Set fs = CreateObject("Scripting.FileSystemObject")
	'Try to find movie title
	strMovieTitle = ""
	'See if the file has movie title properties
	If strMovieTitle = "" Then strMovieTitle = MediaInfo(strFile, "Title")
	If strMovieTitle = "" Then strMovieTitle = MediaInfo(strFile, "Movie")
	'If no file properties, use the file name as the movie name
	If strMovieTitle = "" Then 
		strMovieTitle = fs.GetBaseName(strFile)
		If fs.GetExtensionName(strFile) = "dvr-ms" Then
			If InStr(strMovieTitle, "_") <> 0 Then 
				strMovieTitle = Left(strMovieTitle, InStr(strMovieTitle, "_") - 1)
			End If
		End If
		If fs.GetExtensionName(strFile) = "wmv" Then
			If InStr(strMovieTitle, " - ") <> 0 Then 
				strMovieTitle = Right(strMovieTitle, InStr(strMovieTitle, " - ") + 3)
			End If
		End If
	End If
	strMovieTitle = Sanitize(strMovieTitle)
	If VERBOSE Then Status "MOVIE TITLE: " & strMovieTitle
	MovieTitle = strMovieTitle
End Function

Function MovieGenre(strFile, strMovieTitle)
'Returns a likely genre category list from a filename and title input
Dim fs, strMovieGenre, strKey, strKeys
	On Error Resume Next
	Set fs = CreateObject("Scripting.FileSystemObject")
	'Default value
	strMovieGenre = ""
	'See if the file has genre properties
	If strMovieGenre = "" Then strMovieGenre = MediaInfo(strFile, "Genre")
	'If no file properties, try IMDB
	If strMovieGenre = "" Then 
		For Each strKey In gdicImdbData.Keys
			If strKeys <> "" Then strKeys = strKeys & ", "
			strKeys = strKeys & """" & strKey & """"
		Next
		If VERBOSE Then Status "IMDB SEARCHING KEYS: " & strKeys
		strMovieGenre = gdicImdbData.Item("Genre")
		If VERBOSE Then Status "IMDB GENRE: " & strMovieGenre
	End If
	If VERBOSE Then Status "MOVIE GENRE: " & strMovieGenre
	strMovieGenre = Sanitize(strMovieGenre)
	MovieGenre = strMovieGenre
End Function

Function MovieDescription(strFile, strMovieTitle)
'Returns a likely plot description from a filename and title input
Dim strMovieDescription, strKey, strKeys
	On Error Resume Next
	strMovieDescription = ""
	'See if the file has existing description properties
	If strMovieDescription = "" Then strMovieDescription = Sanitize(MediaInfo(strFile, "Comment"))
	If strMovieDescription = "" Then strMovieDescription = Sanitize(MediaInfo(strFile, "Title/More"))
	If strMovieDescription = "" Then strMovieDescription = Sanitize(MediaInfo(strFile, "Movie/More"))
	'See if we can get plot description from imdb.com
	If strMovieDescription = "" Then 
		For Each strKey In gdicImdbData.Keys
			If strKeys <> "" Then strKeys = strKeys & ", "
			strKeys = strKeys & """" & strKey & """"
		Next
		If VERBOSE Then Status "IMDB SEARCHING KEYS: " & strKeys
		strMovieDescription = Sanitize(gdicImdbData.Item("Plot Outline"))
		If VERBOSE Then Status "IMDB PLOT OUTLINE: " & Left(strMovieDescription, 50) & " ..."
	End If
	If strMovieDescription = "" Then 
		For Each strKey In gdicImdbData.Keys
			If strKeys <> "" Then strKeys = strKeys & ", "
			strKeys = strKeys & """" & strKey & """"
		Next
		If VERBOSE Then Status "IMDB SEARCHING KEYS: " & strKeys
		strMovieDescription = Sanitize(gdicImdbData.Item("Tagline"))
		If VERBOSE Then Status "IMDB TAGLINE: " & Left(strMovieDescription, 50) & " ..."
	End If
	'Return a value
	strMovieDescription = Sanitize(strMovieDescription)
	If VERBOSE Then Status "MOVIE DESCRIPTION: " & Left(strMovieDescription, 50) & " ..."
	MovieDescription = strMovieDescription
End Function

Function MovieReleaseDate(strFile, strMovieTitle)
'Find the movie release date from a filename and title input
'Date is returned in YYYY-MM-DD HH:MM:SS format
Dim strMovieReleaseDate, strKey, strKeys
	On Error Resume Next
	strMovieReleaseDate = ""
	'See if the file has release date properties 
	If strMovieReleaseDate = "" Then 
		strMovieReleaseDate = FirstNumber(MediaInfo(strFile, "Original/Released_Date"))
		If IsNumeric(strMovieReleaseDate) Then 
			If Clng(strMovieReleaseDate) < Clng(1900) Then 
				If VERBOSE Then Status "INVALID DATE: Original/Released_Date " & strMovieReleaseDate
				strMovieReleaseDate = ""
			Else
				If VERBOSE Then Status "DATE: Original/Released_Date " & strMovieReleaseDate
			End If
		Else
			If VERBOSE Then Status "INVALID DATE: " & strMovieReleaseDate
			strMovieReleaseDate = ""
		End If
	End If
	If strMovieReleaseDate = "" Then 
		strMovieReleaseDate = FirstNumber(MediaInfo(strFile, "WM/MediaOriginalBroadcastDate"))
		If IsNumeric(strMovieReleaseDate) Then 
			If Clng(strMovieReleaseDate) < Clng(1900) Then 
				If VERBOSE Then Status "INVALID DATE: WM/MediaOriginalBroadcastDate " & strMovieReleaseDate
				strMovieReleaseDate = ""
			Else
				If VERBOSE Then Status "DATE: WM/MediaOriginalBroadcastDate " & strMovieReleaseDate
			End If
		Else
			If VERBOSE Then Status "INVALID DATE: " & strMovieReleaseDate
			strMovieReleaseDate = ""
		End If
	End If
	'See if we can get a release date from imdb.com
	If strMovieReleaseDate = "" Then 
		For Each strKey In gdicImdbData.Keys
			If strKeys <> "" Then strKeys = strKeys & ", "
			strKeys = strKeys & """" & strKey & """"
		Next
		If VERBOSE Then Status "IMDB SEARCHING KEYS: " & strKeys
		strMovieReleaseDate = gdicImdbData.Item("Release Date")
		If VERBOSE Then Status "IMDB RELEASE DATE: " & strMovieReleaseDate
		If strMovieReleaseDate <> "" Then 
			'Convert freeform text into a decent date
			If InStr(strMovieReleaseDate, "(") <> 0 Then 
				strMovieReleaseDate = Left(strMovieReleaseDate, InStr(strMovieReleaseDate, "(") - 1)
				If VERBOSE Then Status "IMDB RELEASE DATE EDITED: " & strMovieReleaseDate
			End If
			If IsDate(strMovieReleaseDate) Then
				strMovieReleaseDate = Year(CDate(strMovieReleaseDate))
			Else
				If VERBOSE Then Status "IMDB RELEASE DATE IS NOT A DATE"
				strMovieReleaseDate = ""
			End If
		End If
	End If
	'Settle for encoded date which hopefully proxies for air date.
	If strMovieReleaseDate = "" Then 
		strMovieReleaseDate = FirstNumber(MediaInfo(fil.Path, "Encoded date"))
		If IsNumeric(strMovieReleaseDate) Then 
			If Clng(strMovieReleaseDate) < Clng(1900) Then 
				If VERBOSE Then Status "INVALID DATE: Encoded date " & strMovieReleaseDate
				strMovieReleaseDate = ""
			Else
				If VERBOSE Then Status "DATE: Encoded date " & strMovieReleaseDate
			End If
		Else
			If VERBOSE Then Status "INVALID DATE: " & strMovieReleaseDate
			strMovieReleaseDate = ""
		End If
	End If
	'If all else fails, just use the source file date
	If strMovieReleaseDate = "" Then 
		If VERBOSE Then Status "USING FILE DATE"
		strMovieReleaseDate = Year(CreateObject("Scripting.FileSystemObject").GetFile(strFile).DateCreated)
	End If
	'Just in case I blew everything, return something
	If strMovieReleaseDate = "" Then 
		strMovieReleaseDate = "1900"
	End If
	'Return a value
	'strMovieReleaseDate = strMovieReleaseDate & "-01-01 00:00:00"
	If VERBOSE Then Status "MOVIE RELEASE DATE: " & strMovieReleaseDate
	MovieReleaseDate = strMovieReleaseDate
End Function

Function MediaInfo(strFile, strName)
'Returns the value of a named element in the media file. 
Dim obj, hnd, strInfo, fs, ws, ts
	Set obj = Nothing
	strInfo = ""
	On Error Resume Next
	Set fs = CreateObject("Scripting.FileSystemObject")
	'Try running the command line version
	If VERBOSE Then Status "RUNNING: " & "mediainfo.exe --Inform=General;%" & strName & "% " & """" & strFile & """"
	Set ws = CreateObject("Wscript.Shell")
	On Error Resume Next
	Err.Clear
	Set ts = ws.Exec("mediainfo.exe --Inform=General;%" & strName & "% " & """" & strFile & """")
	If Err.Number <> 0 Then
		'Run the ActiveX version of MediaInfo
		Set obj = CreateObject("MediaInfo.ActiveX")
		If Not (obj Is Nothing) Then
			If VERBOSE Then Status "RUNNING MediaInfo.ActiveX"
			hnd = obj.MediaInfo_New()
			'MediaInfo can't take variables, but works with this:
			obj.MediaInfo_Open hnd, fs.GetFile(strFile).Path
			strInfo = obj.MediaInfo_Get(hnd, 0, 0, Cstr(strName), 1, 0)
			obj.MediaInfo_Close hnd
			obj.MediaInfo_Delete hnd
		End If
	Else
		'Get the output from the command line version
		Do While ts.Status = 0
			WScript.Sleep 100
		Loop
		strInfo = ts.StdOut.ReadAll
	End If
	'Return a value
	strInfo = Sanitize(strInfo)
	If VERBOSE Then Status "PROPERTY " & strName & ": " & Left(strInfo, 50)
	MediaInfo = strInfo
End Function

Function MovieSubTitleFile(strInputFile, strOutputFile)
'Returns a file name containing subtitles
'If it finds "dvr-ms" closed-captions, it will create and copy an SRT file to the output folder.
'Uses ExtractClosedCaptions.exe from
'http://www.showanalyser.com/forums/attachment.php?s=cfbfdaa49a8d8af0abf477698eacf7bc&attachmentid=149&d=1186915917
Dim ws, fs, strSubtitles, strSubFile, strSubtitleExtension, strCommand
Const WshNormalFocus = 1
Const WshMinimizedNoFocus = 7
	Set ws = CreateObject("Wscript.Shell")
	Set fs = CreateObject("Scripting.FileSystemObject")
	strSubtitles = "" 'Set the default return value

	'First try creating a subtitle file from the closed captions in a dvr-ms file
	If fs.GetExtensionName(strInputFile) = "dvr-ms" Then
		'Only run the command if we don't already have an SRT file
		If Not(fs.FileExists( fs.BuildPath(fs.GetParentFolderName(strOutputFile), fs.GetBaseName(strOutputFile) & ".srt"))) Then
			On Error Resume Next
			strCommand = "ExtractClosedCaptions.exe " & """" & strInputFile & """" & " " & "2500"
			If VERBOSE Then
				Status "RUNNING: " & strCommand
			Else
				Status "CONVERTING CLOSED CAPTIONS INTO SUBTITLES ..."
			End If
			ws.Run strCommand, WshMinimizedNoFocus, True
			WScript.Sleep 2000 'Give time for antivirus test so file can be recognized by file system
			'If it worked, an SRT file was created
			strSubFile = Replace(strInputFile, ".dvr-ms", ".srt")
			strSubFile = fs.BuildPath(fs.GetParentFolderName(strInputFile), fs.GetBaseName(strInputFile) & ".srt")
			If fs.FileExists(strSubFile) Then
				If VERBOSE Then Status "SUBTITLE FILE EXISTS: " & strSubFile
				'Figure out the name of the subtitle final location
				strSubtitles = fs.BuildPath(fs.GetParentFolderName(strOutputFile), fs.GetBaseName(strOutputFile) & ".srt")
				'Move the subtitle file to the output folder
				If VERBOSE Then Status "SUBTITLE FILE MOVING: " & strSubtitles
				fs.CopyFile strSubFile, strSubtitles, False
				If DELETE_SOURCE_FILES Then 
					If ((fs.FileExists(strSubtitles)) And (fs.FileExists(strSubFile))) Then RecycleFile strSubFile
				End If
				If fs.FileExists(strSubtitles) Then
					If VERBOSE Then Status "SUBTITLE FILE MOVED: " & strSubtitles
					'Fix the timing problem endemic to ExtractClosedCaptions.exe SRT files
					SubtitleSrtLimit strSubtitles
				Else
					If VERBOSE Then Status "SUBTITLE FILE MOVE FAILED"
				End If
			Else
				If VERBOSE Then Status "SUBTITLE FILE NOT CREATED: " & strSubFile
			End If
		End If
	End If

	'See if there is an existing subtitle file in the destination folder
	If strSubtitles = "" Then
		For Each strSubtitleExtension In Split(SUBTITLE_EXTENSIONS, ".") 
			'Pick the first good file and ignore the rest
			If strSubtitles = "" Then
				'Check to see if the source file exists
				strSubtitles = fs.BuildPath(fs.GetParentFolderName(strOutputFile), fs.GetBaseName(strOutputFile) & "." & strSubtitleExtension)
				If Not fs.FileExists(strSubtitles) Then strSubtitles = ""
			End If
		Next
	End If
	'Return a value
	If VERBOSE Then Status "SUBTITLE FILE: " & strSubTitles
	MovieSubTitleFile = strSubTitles
End Function 

Function CreateDictionaryIMDB(strMovieTitle)
'Get movie data from IMDB in form of a dictionary
Dim strTitle, strUrl, strData, strName, strValue, dict
Const FEELING_LUCKY = True 'If you want to take the first hit on an inexact title match
Const NAME_START = "<div class=""info""><h5>"
Const NAME_STOP = ":"
Const VALUE_START = "</h5>"
Const VALUE_STOP = "</div>"
Const LUCKY_LINK_START = "<br>1.</td>"
	Set dict = CreateObject("Scripting.Dictionary")
	strTitle = strMovieTitle
	strTitle = Replace(strTitle, """", "")
	strTitle = Trim(strTitle)
	strTitle = Replace(strTitle, " ", "+")
	strUrl = "http://www.imdb.com/Tsearch?title=" & strTitle
	If VERBOSE Then Status "IMDB RETRIEVING: " & strUrl
	strData = GetData(strUrl)
	strData = Replace(strData, vbCr, "")
	strData = Replace(strData, vbLf, "")
	If InStr(1, strData, "<title>imdb", vbTextCompare) <> 0 Then
		'No exact match
		If Not FEELING_LUCKY Then
			'Not feeling lucky? Return an empty dictionary.
			If VERBOSE Then Status "IMDB NOT FEELING LUCKY"
			IMDB = dict
			Exit Function
		Else
			'Feeling lucky? Follow the first movie link on the page.
			If Instr(1, strData, LUCKY_LINK_START, vbTextCompare) = 0 Then
				If VERBOSE Then Status "IMDB NO MATCHES"
				strData = ""
			Else
				strUrl = Mid(strData, Instr(1, strData, LUCKY_LINK_START, vbTextCompare))
				strUrl = Mid(strUrl, InStr(1, strUrl, " href", vbTextCompare) + 5)
				Do While InStr(" ""=", Left(strUrl, 1)) <> 0
					strUrl = Mid(strUrl, 2)
				Loop
				strUrl = Left(strUrl, InStr(strUrl, ">") - 1)
				Do While InStr(">"" ", Right(strUrl, 1)) <> 0
					strUrl = Left(strUrl, Len(strUrl) - 1)
				Loop
				strUrl = MakeAbsolute(strUrl, "http://www.imdb.com/find")
				If VERBOSE Then Status "IMDB RETRIEVING LUCKY GUESS: " & strUrl
				strData = GetData(strUrl)
				strData = Replace(strData, vbCr, "")
				strData = Replace(strData, vbLf, "")
			End If
		End If
	Else
		If VERBOSE Then Status "IMDB EXACT MATCH FOUND"
	End If
	'Parse the results and save them in a dictionary
	Do While InStr(strData, NAME_START) <> 0
		strData = Mid(strData, InStr(strData, NAME_START) + Len(NAME_START))
		strName = Left(strData, InStr(strData, NAME_STOP) - 1)
		strName = Sanitize(strName)
		strData = Mid(strData, InStr(strData, VALUE_START))
		strValue = Left(strData, InStr(strData, VALUE_STOP) - 1)
		strValue = UnescapeHtml(strValue) 
		strValue = Trim(strValue)
		If Right(strValue, 4) = "more" Then strValue = Left(strValue, Len(strValue) - 4)
		strValue = Sanitize(strValue)
		If Right(strValue, 4) = "more" Then strValue = Left(strValue, Len(strValue) - 4)
		If Not dict.Exists(strName) Then
			If VERBOSE Then Status "IMDB " & strName & ": " & Left(strValue, 50)
			dict.Add strName, strValue
		End If
	Loop
	'Return the full dictionary
	Set CreateDictionaryIMDB = dict
End Function

Function Sanitize(strRawData)
'Removes linefeeds, tabs, excess spaces, quotes
Dim strData
	strData = strRawData
	strData = Replace(strData, """", "")
	strData = Replace(strData, vbCr, " ")
	strData = Replace(strData, vbLf, " ")
	strData = Replace(strData, vbTab, " ")
	strData = KillBetween(strData, "<", ">")
	strData = KillBetween(strData, "<", ">")
	strData = KillBetween(strData, "<", ">")
	Do While InStr(strData, "  ") <> 0
		strData = Replace(strData, "  ", " ")
	Loop
	strData = Trim(strData)
	strData = Left(strData, 254)
	Sanitize = strData
End Function

Function GetData(strUrl)
'Returns string from an HTTP URL
Dim web
Const WinHttpRequestOption_EnableRedirects = 6
	Set web = Nothing
	On Error Resume Next
	Set web = CreateObject("WinHttp.WinHttpRequest.5.1")
	If web Is Nothing Then Set web = CreateObject("WinHttp.WinHttpRequest")
	If web Is Nothing Then Set web = CreateObject("MSXML2.ServerXMLHTTP")
	If web Is Nothing Then Set web = CreateObject("Microsoft.XMLHTTP")
	If web Is Nothing Then
		GetData = ""
		Exit Function
	End If
	web.Option(WinHttpRequestOption_EnableRedirects) = True
	web.Open "GET", strURL, False
	web.SetRequestHeader "REFERER", strUrl
 	web.SetRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)"
 	web.SetRequestHeader "Accept", "text/xml,application/xml,application/xhtml+xml,text/html;q=0.9,text/plain;q=0.8,image/png,*/*;q=0.5"
 	web.SetRequestHeader "Accept-Language", "en-us,en;q=0.5"
 	web.SetRequestHeader "Accept-Charset", "ISO-8859-1,utf-8;q=0.7,*;q=0.7"
	web.Send
	If web.Status = "200" Then
		GetData = web.ResponseText
	Else
		GetData = ""
	End If
End Function

Function KillBetween(strText, strStart, strEnd) 
'Used here to remove all HTML tags
Dim strIn, strOut
Dim lngStart, lngEnd
	'Do we have anything to do?
	lngStart = InStr(1, strText, strStart, vbTextCompare)
	If lngStart = 0 Then
		KillBetween = strText
		Exit Function
	End If
	lngEnd = InStr(lngStart, strText, strEnd, vbTextCompare)
	If lngEnd = 0 Then
		KillBetween = strText
		Exit Function
	End If
	strIn = strText 'Don't modify input variables
	strOut = "" 'Start with nothing
	Do
		'Get all text up to the start of tag
		strOut = strOut & Left(strIn, lngStart - 1)
		'Wipe out everything up to the end of the section
		strIn = Mid(strIn, lngEnd + Len(strEnd))
		lngStart = InStr(1, strIn, strStart, vbTextCompare)
		If lngStart = 0 Then Exit Do
		lngEnd = InStr(lngStart, strIn, strEnd, vbTextCompare)
		If lngEnd = 0 Then Exit Do
	Loop
	KillBetween = strOut & " " & strIn
End Function

Function MakeAbsolute(strLinkURL, strCurrentURL)
'Returns an absolute link URL. The strLinkURL can be 
'any type, but the strCurrentURL must be absolute.
Dim strCurrentFolder, strMakeAbsolute, strRoot, strDocument, strPart1, strPart2, lngDots
	strRoot = "" 'Initialize empty because we'll test later to see if it's been set.
	
	'There are 3 link types: absolute, root, and relative.
	'Handle the easiest case: Is strLinkURL already absolute?
	If Left(strLinkURL, 7) = "http://" Then
		MakeAbsolute = strLinkURL
		Exit Function
	End If
	'Now we only have 2 remaining link types: root and relative
	
	'There are 3 current URL types: document, folder, and root.
	'Take the strCurrentURL and generate a current folder and root (both with no trailing slash)
	strCurrentFolder = Split(strCurrentURL, "?")(0) 'Remove any GET arguments
	If InStr(8, strCurrentFolder, "/") <> 0 Then
		'strCurrentFolder is a document or a folder. Crop to the last slash to make it a folder.
		strCurrentFolder = Left(strCurrentFolder, InStrRev(strCurrentFolder, "/") - 1)
		If InStr(8, strCurrentFolder, "/") = 0 Then
			strRoot = strCurrentFolder
		Else
			strRoot = Left(strCurrentFolder, InStr(8, strCurrentFolder, "/") - 1)
		End If
	Else
		'strCurrentFolder must be a root (http://nowhere.com/). Be sure it has no trailing slash.
		If Right(strCurrentFolder, 1) = "/" Then
			strCurrentFolder = Left(strCurrentFolder, Len(strCurrentFolder) - 1)
			strRoot = strCurrentFolder 
		End If
	End If
	
	'Handle the next easiest link type: Is strLinkURL a root reference?
	If Left(strLinkURL, 1) = "/" Then
		MakeAbsolute = strRoot & strLinkURL
		Exit Function
	End If
	'Now the only link type we have is relative.
	
	'Now handle the relative link. 
	strMakeAbsolute = strCurrentFolder & "/" & strLinkURL
	'Remove any double dots
	Do While InStr(strMakeAbsolute, "/../") <> 0 'http://machine/a/b/../index.html
		lngDots = InStr(strMakeAbsolute, "/../")
		strPart1 = Left(strMakeAbsolute, lngDots - 1) 'http://machine/a/b
		strPart2 = Mid(strMakeAbsolute, lngDots + 3) '/index.html
		strPart1 = Left(strPart1, InStrRev(strPart1, "/") - 1) 'http://machine/a
		strMakeAbsolute = strPart1 & strPart2 'http://machine/a/index.html
	Loop
	MakeAbsolute = strMakeAbsolute
End Function

Function UnescapeHtml(strHtml)
Dim strOut, strChar, strWord
Dim lngLength, lngPosition, lngChar
    strOut = strHtml
    'Replace hex escapes.
    lngPosition = Instr(strOut, "&#x")
    Do While lngPosition <> 0
        'Get the number after the &# sequence
        strChar = FirstNumber(Mid(strOut, lngPosition, 9))
        lngLength = Len("&#x" & strChar)
        'Is there a trailing semicolon?
        If Mid(strOut, lngPosition + lngLength, 1) = ";" Then
            lngLength = lngLength + 1
        End If
        'Convert the number after &# to an ASCII or Unicode character
        lngChar = CLng("&H" & strChar)
        If lngChar > 255 Then
            strChar = ChrW(lngChar)
        Else
            strChar = Chr(lngChar)
        End If
        'Replace the escaped sequence with the actual character
        strOut = Left(strOut, lngPosition - 1) & strChar & Mid(strOut, lngPosition + lngLength)
        lngPosition = Instr(strOut, "&#x")
    Loop
    'Replace decimal escapes.
    lngPosition = Instr(strOut, "&#")
    Do While lngPosition <> 0
        'Get the number after the &# sequence
        strChar = FirstNumber(Mid(strOut, lngPosition, 6))
        lngLength = Len("&#" & strChar)
        'Is there a trailing semicolon?
        If Mid(strOut, lngPosition + lngLength, 1) = ";" Then
            lngLength = lngLength + 1
        End If
        'Convert the number after &# to an ASCII or Unicode character
        lngChar = CLng(strChar)
        If lngChar > 255 Then
            strChar = ChrW(lngChar)
        Else
            strChar = Chr(lngChar)
        End If
        'Replace the escaped sequence with the actual character
        strOut = Left(strOut, lngPosition - 1) & strChar & Mid(strOut, lngPosition + lngLength)
        lngPosition = Instr(strOut, "&#")
    Loop
    'Replace common workaround for TradeMark character
	Do While Instr(strOut, "<SUP><SMALL>TM</SMALL></SUP>") <> 0 : strOut = Replace(strOut, "<SUP><SMALL>TM</SMALL></SUP>", Chr(153)) : Loop
	Do While Instr(strOut, "<sup><small>TM</small></sup>") <> 0 : strOut = Replace(strOut, "<sup><small>TM</small></sup>", Chr(153)) : Loop
	'Replace odd apostrophe
	Do While Instr(strOut, "’") <> 0 : strOut = Replace(strOut, "’", "'") : Loop
    'Replace items with duplicate codes
	ReplaceHtmlEscape strOut, "&minus;", 45
	ReplaceHtmlEscape strOut, "&sol;", 47
	ReplaceHtmlEscape strOut, "&horbar;", 95
	ReplaceHtmlEscape strOut, "&ldots;", 133
	ReplaceHtmlEscape strOut, "&rsquor;", 145
	ReplaceHtmlEscape strOut, "&rdquor;", 147
	ReplaceHtmlEscape strOut, "&endash;", 150
	ReplaceHtmlEscape strOut, "&mdash;", 151
	ReplaceHtmlEscape strOut, "&brkbar;", 166
	ReplaceHtmlEscape strOut, "&die;", 168
	ReplaceHtmlEscape strOut, "&half;", 189
    ReplaceHtmlEscape strOut, "&euro;", 128
    'Now continue unescaping everything else
    lngChar = 32
    For Each strWord In Split("sp excl quot num dollar percnt amp apos lpar rpar ast plus comma hyphen period")
    	ReplaceHtmlEscape strOut, strWord, lngChar
    	lngChar = lngChar + 1
    Next
	lngChar = 58
	For Each strWord In Split("colon semi lt equals gt quest commat")
    	ReplaceHtmlEscape strOut, strWord, lngChar
    	lngChar = lngChar + 1
    Next
    lngChar = 91
    For Each strWord In Split("lsqb bsol rsqb circ lowbar grave")
    	ReplaceHtmlEscape strOut, strWord, lngChar
    	lngChar = lngChar + 1
    Next
    lngChar = 123
    For Each strWord In Split("lcub verbar rcub tilde")
    	ReplaceHtmlEscape strOut, strWord, lngChar
    	lngChar = lngChar + 1
    Next
    lngChar = 130
    For Each strWord In Split("lsquor fnof ldquor hellip dagger Dagger")
    	ReplaceHtmlEscape strOut, strWord, lngChar
    	lngChar = lngChar + 1
    Next
    lngChar = 137
    For Each strWord In Split("permil Scaron lsaquo OElig")
    	ReplaceHtmlEscape strOut, strWord, lngChar
    	lngChar = lngChar + 1
    Next
    lngChar = 145
    For Each strWord In Split("lsquo rsquo ldquo rdquo bull ndash emdash tilde trade scaron rsaquo oelig")
    	ReplaceHtmlEscape strOut, strWord, lngChar
    	lngChar = lngChar + 1
    Next
    lngChar = 159
    For Each strWord In Split("Yuml nbsp iexcl cent pound curren yen brvbar sect uml")
    	ReplaceHtmlEscape strOut, strWord, lngChar
    	lngChar = lngChar + 1
    Next
    lngChar = 169
    For Each strWord In Split("copy ordf laquo not shy reg macr deg plusmn sup2 sup3 acute micro para middot cedil sup1 ordm raquo frac14 frac12")
    	ReplaceHtmlEscape strOut, strWord, lngChar
    	lngChar = lngChar + 1
    Next
    lngChar = 190
    For Each strWord In Split("frac34 iquest Agrave Aacute Acirc Atilde Auml Aring AElig Ccedil Egrave Eacute Ecirc Euml Igrave Iacute Icirc Iuml ETH Ntilde Ograve Oacute Ocirc Otilde Ouml times Oslash Ugrave Uacute Ucirc Uuml Yacute THORN szlig agrave aacute acirc atilde auml aring aelig ccedil egrave eacute ecirc euml igrave iacute icirc iuml eth ntilde ograve oacute ocirc otilde ouml divide oslash ugrave uacute ucirc uuml yacute thorn yuml")
    	ReplaceHtmlEscape strOut, strWord, lngChar
    	lngChar = lngChar + 1
    Next

    UnescapeHtml = strOut
End Function

Sub ReplaceHtmlEscape(ByRef strHtmlText, strEscapeString, lngCharCode)
'MODIFIES INPUT DATA strHtmlText
Dim strEscape, strCharCode
    'Starting values
    strEscape = strEscapeString
    strCharCode = Chr(lngCharCode)
    'First make the escape string "Microsoft format" (no trailing semicolon).
    If Left(strEscape, 1) <> "&" Then strEscape = "&" & strEscape
    If Right(strEscape, 1) = ";" Then strEscape = Left(strEscape, Len(strEscape) - 1)
    'Replace standard format
    Do While Instr(strHtmlText, strEscape & ";") <> 0
        strHtmlText = Replace(strHtmlText, strEscape & ";", strCharCode, 1, -1, vbTextCompare)
    Loop
    'Replace Microsoft format
    Do While Instr(strHtmlText, strEscape) <> 0
        strHtmlText = Replace(strHtmlText, strEscape, strCharCode, 1, -1, vbTextCompare)
    Loop
End Sub

Function FirstNumber(strNumber) 'As String
'Returns the first number in a string. For example
'CA0567-2 returns 0567
'If there are no numbers, an empty string is returned.
Dim strBuffer
Dim intCounter
Dim blnNumeric
	If IsNull(strNumber) Then
		FirstNumber = ""
		Exit Function
	End If
	If strNumber = "" Then
		FirstNumber = ""
		Exit Function
	End If
	strBuffer = ""
	blnNumeric = False
	For intCounter = 1 To Len(strNumber)
		If IsNumeric(Mid(strNumber, intCounter, 1)) Then
			blnNumeric = True
			strBuffer = strBuffer & Mid(strNumber, intCounter, 1)
		Else
			If blnNumeric Then Exit For
		End If
	Next
	FirstNumber = strBuffer
End Function

Function CreateDictionary(strMultiplyDelimitedString, strItemSeparator, strEntrySeparator) 'As Scripting.Dictionary
'Accepts a multiply-delimited string and returns a dictionary. For example
'Set dict=CreateDictionary("counts=9.3&name=Eric Phelps", "=", "&") becomes available like this...
'dict.Item("counts") will return "9.3", and dict.Item("name") returns "Eric Phelps".
'Likewise dict.Exists("counts") is True and dict.Exists("xyftc") is False.
Dim strQuery 'As String
Dim strName 'As String
Dim strValue 'As String
Dim dict 'As Object
	Set dict = CreateObject("Scripting.Dictionary")
	strQuery = strMultiplyDelimitedString
	Do While strQuery <> ""
		strName = Left(strQuery, InStr(strQuery, strItemSeparator) - 1)
		strQuery = Mid(strQuery, InStr(strQuery, strItemSeparator) + Len(strItemSeparator))
		If InStr(strQuery, strEntrySeparator) = 0 Then
			strValue = strQuery
			strQuery = ""
		Else
			strValue = Left(strQuery, InStr(strQuery, strEntrySeparator) - 1)
			strQuery = Mid(strQuery, InStr(strQuery, strEntrySeparator) + Len(strEntrySeparator))
		End If
		If Not dict.Exists(strName) Then
			dict.Add strName, strValue
		End If
	Loop
	Set CreateDictionary = dict
	Set dict = Nothing
End Function

Sub RecycleFile(strFilePath)
	If CreateObject("Scripting.FileSystemObject").FileExists(strFilePath) Then
		CreateObject("Shell.Application").NameSpace(strFilePath).Self.InvokeVerb("&Delete")
	End If
End Sub

Sub Status (strMessage)
'If the program was run with CSCRIPT, this writes a line into the DOS box. 
	If Lcase(Right(Wscript.FullName, 12)) = "\cscript.exe" Then 
		Wscript.Echo strMessage
		'And optionally write the message to a log file!
		If VERBOSE And LOGGING Then 
			'Don't log the "Waiting" messages
			If Instr(strMessage, "Waiting") <> 1 Then
				WriteLog strMessage			
			End If
		End If
	End If
End Sub

Sub WriteLog(strText)
Dim fs 'As Scripting.FileSystemObject
Dim ts 'As Scripting.TextStream
Const ForAppending = 8
	Set fs = CreateObject("Scripting.FileSystemObject")
	Set ts = fs.OpenTextFile(Left(Wscript.ScriptFullName, InstrRev(Wscript.ScriptFullName, ".")) & "log", ForAppending, True)
	ts.WriteLine strText
	ts.Close
End Sub

Function RemoveSpaces(strFile)
'Turns strings like "Your name here" into "YourNameHere"
Dim strFileName, strPunctuation
	strFileName = strFile
	'Remove the spaces -and- capitalize each word
	Do While Instr(strFileName, " ") <> 0
		strFileName = Left(strFileName, Instr(strFileName, " ") -1) & Ucase(Mid(strFileName, Instr(strFileName, " ") + 1, 1)) & Mid(strFileName, Instr(strFileName, " ") + 2)
	Loop
	'Remove punctuation
	For Each strPunctuation In Split("; , ' ( ) ? ~ ! @ # % ^ & * - _ + = |")
		Do While Instr(strFileName, strPunctuation) <> 0
			strFileName = Left(strFileName, Instr(strFileName, strPunctuation) -1) & Mid(strFileName, Instr(strFileName, strPunctuation) + 1)
		Loop
	Next
	RemoveSpaces = strFileName
End Function

Function AddSpaces(strFile)
'Turns strings like "YourNameHere" into "Your Name Here"
'Should also consider strings like "FerrisBueller'sDayOff", "Fail-Safe", "AlienVs.Predator", "12-01"
Dim intLetter, strOut
	strOut = Left(strFile, 1)
	For intLetter = 2 To Len(strFile)
		If UCase(Mid(strFile, intLetter, 1)) = Mid(strFile, intLetter, 1) Then
			'It's upper case, number, or punctuation
			If LCase(Mid(strFile, intLetter, 1)) = Mid(strFile, intLetter, 1) Then
				'It's punctuation or number
				If InStr("0123456789", Mid(strFile, intLetter, 1)) <> 0 Then
					'It's a number
					If Instr("0123456789", Mid(strFile, intLetter - 1, 1)) <> 0 Then
						'It's a number and the previous character was a number. Let it go unchanged.
						strOut = strOut & Mid(strFile, intLetter, 1)
					Else
						'It's the beginning of a number
						If Instr(" -", Mid(strFile, intLetter - 1, 1)) <> 0 Then
							'It's the beginning of a number preceeded by a space or dash. Let it go unchanged.
							strOut = strOut & Mid(strFile, intLetter, 1)
						Else
							'It's the beginning of a number not preceeded by a space or dash... So add a space.
							strOut = strOut & " " & Mid(strFile, intLetter, 1)
						End If
					End If
				Else
					'It's punctuation
				End If
			Else
				'It's upper case
				If Instr(" '-", Mid(strFile, intLetter - 1, 1)) <> 0 Then
					'It's upper case and the previous letter isn't a space or special character... So add a space!
					strOut = strOut & " " & Mid(strFile, intLetter, 1)
				Else
					'It's upper case, but the previous letter was a space or special character. Let it go unchanged.
					strOut = strOut & Mid(strFile, intLetter, 1)
				End If
			End If
		Else
			'It's lower case. Let it go unchanged.
			strOut = strOut & Mid(strFile, intLetter, 1)
		End If
	Next
	AddSpaces = strOut
End Function

Function LongName(strFullPathAndFile)
'Converts a legitimate short file name into the long file name
Dim strOriginalFile
Dim fs, fil, fils, fol
Dim blnFound
	Set fs = CreateObject("Scripting.FileSystemObject")
	blnFound = False
	strOriginalFile = fs.GetFile(strFullPathAndFile).ShortPath
	Set fol = fs.GetFolder(fs.GetParentFolderName(strFullPathAndFile))
	Set fils = fol.Files
	For Each fil In fils
		If fil.ShortPath = strOriginalFile Then
			strOriginalFile = fil.Path
			blnFound = True
			Exit For
		End If
	Next
	If blnFound Then
		LongName = strOriginalFile
	Else
		LongName = strFullPathAndFile
	End If
End Function

Sub SubtitleSmiTimimgAdjust(strFile)
'Originally designed for an interactive two-point correction, this 
'subroutine has been modified to be non-interactive with a constant
'timing offset. 
Const ForReading = 1
Dim fs, ts, strLine, strSmil
Dim lngStart, lngEnd, strStart, strEnd, strTimeCodeMillisecs, lngTimeCodeMillisecs, lngCorrectedTimeCodeMillisecs
Dim dblTime1, dblTime2, dblCorrection1, dblCorrection2, dblSlope, dblOffset
'Get the correction data
dblTime1 = 0 
dblCorrection1 = SMI_TIMING_CORRECTION 
dblTime2 = 60 
dblCorrection2 = SMI_TIMING_CORRECTION 
'Standardize everything in milliseconds
dblTime1 = dblTime1 * 60000
dblTime2 = dblTime2 * 60000
dblCorrection1 = dblCorrection1 * 1000
dblCorrection2 = dblCorrection2 * 1000
'Calculate the correction slope
dblSlope = (dblCorrection2 - dblCorrection1) / (dblTime2 - dblTime1)
'Calculate the correction offset
dblOffset = dblCorrection1 - (dblTime1 * dblSlope)

	Set fs = CreateObject("Scripting.FileSystemObject")
	If Not fs.FileExists(strFile) Then Exit Sub
	Set ts = fs.OpenTextFile(strFile, ForReading, True)
	strSmil = ""
	Do Until ts.AtEndOfStream
		'Read a line in and add a CRLF to the output
		strLine = ts.ReadLine
		If strSmil <> "" Then strSmil = strSmil & vbCrLf
		'See if the line has SYNC caption timing data
		lngStart = InStr(1, strLine, "<SYNC", vbTextCompare)
		If lngStart <> 0 Then
			'Walk through the SYNC tag to the START, then to the = to find the number
			lngStart = InStr(lngStart, strLine, "START", vbTextCompare)
			lngStart = InStr(lngStart, strLine, "=", vbTextCompare)
			lngStart = lngStart + 1
			'Find the end of the SYNC tag. Really hope there's nothing between the number and the end of the tag!
			lngEnd = InStr(lngStart, strLine, ">", vbTextCompare)
			strStart = Left(strLine, lngStart - 1)
			strEnd = Mid(strLine, lngEnd)
			'The SYNC time code is now (hopefully) available
			strTimeCodeMillisecs = Mid(strLine, lngStart, lngEnd - lngStart)
			'Clean up the time code
			strTimeCodeMillisecs = Replace(strTimeCodeMillisecs, """", "")
			strTimeCodeMillisecs = Trim(strTimeCodeMillisecs)
			'With any luck we actually retrieved a number
			If IsNumeric(strTimeCodeMillisecs) Then
				lngTimeCodeMillisecs = CLng(strTimeCodeMillisecs)
				If lngTimeCodeMillisecs <> 0 Then
					'Add the fixed offset
					lngCorrectedTimeCodeMillisecs = lngTimeCodeMillisecs + dblOffset
					'Add the correction per second
					lngCorrectedTimeCodeMillisecs = Clng(lngCorrectedTimeCodeMillisecs + (lngTimeCodeMillisecs * dblSlope))
					'Make the new line with the corrected value
					strSmil = strSmil & strStart & Cstr(lngCorrectedTimeCodeMillisecs) & strEnd
				Else
					strSmil = strSmil & strLine
				End If
			Else
				strSmil = strSmil & strLine
			End If
		Else
			strSmil = strSmil & strLine
		End If
	Loop
	ts.Close
	String2File strSmil, strFile
End Sub

Sub SubtitleSrtLimit(strFile)
'Fixes SRT files that have audio that appears too early but disappears at the correct time
Dim dblMaxTime, fs, strSubtitleText
	Set fs = CreateObject("Scripting.FileSystemObject")
	dblMaxTime = SRT_SUBTITLE_DEFAULT_MAX_TIME
	If Not fs.FileExists(strFile) Then	Exit Sub
	If Not fs.GetExtensionName(strFile) = "srt" Then Exit Sub
	strSubtitleText = ParseSrtFile(strFile, dblMaxTime)
	String2File strSubtitleText, strFile
End Sub

Function ParseSrtFile(strFile, dblMaxTime)
'SRT subtitle correction. Called by [SubtitleSrtLimit]
Const ForReading = 1
Dim fs, ts, strLine, strCount, strTime, strText, blnProcessed, strSubtitleText
	Set fs = CreateObject("Scripting.FileSystemObject")
	If Not fs.FileExists(strFile) Then 
		ParseSrtFile = ""
		Exit Function
	End If
	Set ts = fs.OpenTextFile(strFile, ForReading, True)
	strTime = ""
	strCount = ""
	strText = ""
	blnProcessed = False
	'Typical entry in SRT file:
	'66
	'00:03:23,429 --> 00:03:26,365
	'TAPS THE BACK OF YOUR FAVORITE HEAD UP AGAINST A BARROOM WALL,
	'
	Do Until ts.AtEndOfStream 
		blnProcessed = False 
		strLine = ts.ReadLine
		If strLine <> "" Then strLine = ConvertToAnsi(strLine)
		'Is the line a counter?
		If Not blnProcessed Then
			If IsNumeric(strLine) Then
				blnProcessed = True
				strCount = strLine
			End If
		End If
		'Is the line timing?
		If Not blnProcessed Then
			If InStr(strLine, " --> ") <> 0 Then
				blnProcessed = True
				strTime = strLine
			End If
		End If
		'Is the line text?
		If Not blnProcessed Then
			'If none of the other tests set blnProcessed, then the line must be subtitle text
			If Trim(strLine) <> "" Then
				blnProcessed = True
				If strText <> "" Then strText = strText & vbCrLf
				strText = strText & strLine
			End If
		End If
		'Is it a blank line?
		If Not blnProcessed Then
			If Trim(strLine) = "" Then
				blnProcessed = True
				strSubtitleText = strSubtitleText & ProcessSrtEntry(strCount, strTime, strText, dblMaxTime)
				strText = ""
				strTime = ""
				strCount = ""				
			End If
		End If
	Loop
	ts.Close
	ParseSrtFile = strSubtitleText
End Function

Function ProcessSrtEntry(strCount, strOriginalTime, strText, dblMaxTime)
'SRT subtitle correction. Called by [ParseSrtFile]
Dim strOut, strTime1, strTime2, strTime, dblTime1, dblTime2, blnChanged
	'Typical entry in SRT file:
	'66
	'00:03:23,429 --> 00:03:26,365
	'TAPS THE BACK OF YOUR FAVORITE HEAD UP AGAINST A BARROOM WALL,
	'
	blnChanged = False
	On Error Resume Next
	Err.Clear
	strTime1 = Split(strOriginalTime, " ")(0)
	strTime2 = Split(strOriginalTime, " ")(2)
	If Err.Number <> 0 Then
		ProcessSrtEntry = ""
		Exit Function
	End If
	dblTime1 = Cdbl(CDate(Split(strTime1, ",")(0))) + Cdbl(Split(strTime1, ",")(1))/86400000
	dblTime2 = Cdbl(CDate(Split(strTime2, ",")(0))) + Cdbl(Split(strTime2, ",")(1))/86400000
	If Err.Number = 0 Then
		If ((dblTime2 - dblTime1) * 86400) > dblMaxTime Then
			blnChanged = True
			dblTime2 = Cdbl(CDate(Split(strTime2, ",")(0))) 'ignore the milliseconds to prevent rounding
			dblTime1 = dblTime2 - (dblMaxTime/86400)
			strTime1 = ""
			strTime1 = Right("00" & Hour(dblTime1), 2)
			strTime1 = strTime1 & ":" & Right("00" & Minute(dblTime1), 2)
			strTime1 = strTime1 & ":" & Right("00" & Split(Second(dblTime1), ".")(0), 2)
			strTime1 = strTime1 & "," & Split(strTime2, ",")(1) 'use the milliseconds from time2 on time1
		End If
	End If
	strOut = ""
	strOut = strOut & strCount & vbCrLf
	strOut = strOut & strTime1 & " --> " & strTime2 & vbCrLf
	strOut = strOut & strText & vbCrLf
	strOut = strOut & vbCrLf
	If blnChanged Then Status strCount & vbTab & Split(strOriginalTime, " ")(0) & " >>> " & strTime1
	ProcessSrtEntry = strOut
End Function

Function SubtitleSmi2Srt(strSmiFile)
'Reads an SMI file and returns SRT formatted subtitle text
''''''''''''''Typical SMI format:
'<!-- 3c8f 942f 0:4:18:658 --><SYNC Start=258658><P>COMPLIMENTS OF THE HOUSE.
'<!-- 3ce5 942c 0:4:20:93 --><SYNC Start=260093><P><br>
''''''''''''''Typical SRT format:
'4
'00:04:18.658 --> 00:04:20.093
'COMPLIMENTS OF THE HOUSE.
'
''''''''''''''''''''''''''''''''
Const ForReading = 1
Dim fs, ts, strLine, strText, strLastText, lngCount
Dim strTime, dblTimeMs, strLastTime, dblLastTimeMs, blnValidTime, strSrtText
	Set fs = CreateObject("Scripting.FileSystemObject")
	Set ts = fs.OpenTextFile(strSmiFile, ForReading, True)
	'Set initial values
	strLastTime = "00:00:00,000"
	dblLastTimeMs = CDbl(0)
	lngCount = 0
	strSrtText = ""
	'Read every line
	Do Until ts.AtEndOfStream
		strLine = ts.ReadLine
		'See if the line has SYNC caption timing data
		If InStr(1, strLine, "<SYNC", vbTextCompare) <> 0 Then
			'Now try to find the milliseconds time code
			strTime = Mid(strLine, InStr(1, strLine, "<SYNC", vbTextCompare) + 5)
			strTime = Mid(strTime, InStr(1, strTime, "START", vbTextCompare) + 5)
			strTime = Mid(strTime, InStr(strTime, "=") + 1)
			strTime = Left(strTime, InStr(strTime, ">") - 1)
			strTime = Replace(strTime, """", "")
			strTime = Replace(strTime, "'", "")
			strTime = Trim(strTime)
			'We have a time code. Check to see if it's valid
			blnValidTime = True
			If Not IsNumeric(strTime) Then 
				blnValidTime = False
			End If
			If blnValidTime Then
				dblTimeMs = CDbl(strTime)
				If dblTimeMs <= dblLastTimeMs Then blnValidTime = False
			End If
			'We only process lines that have valid time codes
			If blnValidTime Then
				'Grabbing the current text is easy
				strText = Replace(strLine, "<br>", " ", 1, -1, vbTextCompare)
				strText = KillBetween(strText, "<", ">")
				strText = Trim(strText)
				strText = Replace(strText, "  ", " ")
				strText = Replace(strText, "  ", " ")
				strText = Replace(strText, "’’", "")
				'Convert the strTime into SRT format
				strTime = ""
				strTime = strTime & Right("00" & Hour(CDate((Int(dblTimeMs/1000))/86400)), 2)
				strTime = strTime & ":" & Right("00" & Minute(CDate((Int(dblTimeMs/1000))/86400)), 2)
				strTime = strTime & ":" & Right("00" & Second(CDate((Int(dblTimeMs/1000))/86400)), 2)
				strTime = strTime & "," _
				& Right("000" & Clng(dblTimeMs - (CDbl(Cdate(strTime)) * 86400000)), 3)
				'Send out data
				If strLastText <> "" Then 
					'Increment the subtitle counter
					lngCount = lngCount + 1
					'Create the SRT output string
					strSrtText = strSrtText & Cstr(lngCount) & vbCrLf
					strSrtText = strSrtText & strLastTime & " --> " & strTime & vbCrLf
					strSrtText = strSrtText & strLastText & vbCrLf & vbCrLf
				End If
				'Save values
				strLastText = strText
				strLastTime = strTime
			End If
		End If
	Loop
	ts.Close
	SubtitleSmi2Srt = strSrtText 
End Function

Function ConvertToAnsi(strData)
'Converts UTF-8 and Unicode to ANSI by discarding non-ANSI characters
Dim strOut, lngCount, lngLength, intChar, strChar
	strOut = ""
	lngLength = Len(strData)
	For lngCount = 1 To lngLength
		strChar = Mid(strData, lngCount, 1)
		intChar = Asc(strChar)
		If ((intChar <> 0) And (intChar < 128)) Then strOut = strOut & Chr(intChar)
	Next
	ConvertToAnsi = strOut
End Function

Function String2File(strData, strFileName)
'Writes a string to a file. Returns True if success.
Dim fs 'As Scripting.FileSystemObject
Dim ts 'As Scripting.TextStream
Dim lngChar, strBlock, intChar, dtTimeStamp
Const ForWriting = 2
	Set fs = CreateObject("Scripting.FileSystemObject")
	On Error Resume Next
	If fs.FileExists(strFileName) Then
		dtTimeStamp = fs.GetFile(strFileName).DateLastModified
	Else
		dtTimeStamp = CDate(0)
	End If
	Err.Clear
	Set ts = fs.OpenTextFile(strFileName, ForWriting, True)
	ts.Write strData
	If Err.Number <> 0 Then
		'Must have hit one of the "problem characters" between 128 and 159
		For lngChar = 1 To Len(strData) Step 100
			Err.Clear
			ts.Write Mid(strData, lngChar, 100)
			If Err.Number <> 0 Then
				'This block of 100 must have the problem. Write them one-at-a-time
				strBlock = Mid(strData, lngChar, 100)
				For intChar = 1 To Len(strBlock)
					ts.Write Chr(255 And AscW(Mid(strBlock, intChar)))
				Next
			End If
		Next
	End If
	ts.Close
	If fs.FileExists(strFileName) Then
		If dtTimeStamp = fs.GetFile(strFileName).DateLastModified Then
			String2File = False
		Else
			String2File = True
		End If
	Else
		String2File = False
	End If
End Function

Function FileNameRelated(strReferenceFileName, strNewFileExtension)
'Returns a file name the same as the reference file name except for the file extension. 
Dim fs, strExtension
	Set fs = CreateObject("Scripting.FileSystemObject")
	If Left(strReferenceFileName, 1) <> "." Then
		strExtension = "." & strNewFileExtension
	Else
		strExtension = strNewFileExtension
	End If
	FileNameRelated = fs.BuildPath(fs.GetParentFolderName(strReferenceFileName), fs.GetBaseName(strReferenceFileName) & strExtension)
End Function

Sub DictionaryToFile(dic, strFile)
'Creates an ini-style file from a dictionary
Dim fs 'As Scripting.FileSystemObject
Dim ts 'As Scripting.TextStream
Dim colNames, strName
Const ForWriting = 2
	Set fs = CreateObject("Scripting.FileSystemObject")
	On Error Resume Next 'Fail silently! We don't actually need external settings.
	Set ts = fs.OpenTextFile(strFile, ForWriting, True)
	ts.WriteLine "[Settings]"
	ts.WriteLine "# Auto created and read by """ & WScript.ScriptFullName & """."
	ts.WriteLine "# May be edited. If this file is deleted, this script will "
	ts.WriteLine "# offer to re-create it with your desired settings."
	colNames = dic.Keys
	For Each strName In colNames
		ts.WriteLine Trim(strName) & "=" & Trim(dic(strName))
	Next
	ts.Close
	On Error Goto 0
End Sub

Function FileToDictionary(strFile)
'Reads an ini-style file and returns a dictionary
Dim fs 'As Scripting.FileSystemObject
Dim ts 'As Scripting.TextStream
Dim strLine, dic, colNames, strName
Const ForReading = 1
	Set dic = CreateObject("Scripting.Dictionary")
	Set fs = CreateObject("Scripting.FileSystemObject")
	If fs.FileExists(strFile) Then
		Set ts = fs.OpenTextFile(strFile, ForReading, True)
		Do Until ts.AtEndOfStream
			strLine = ts.ReadLine
			If ((InStr(strLine, "=") > 1) And (InStr(strLine, "=") < (Len(strLine)))) Then
				If dic.Exists(Split(strLine, "=")(0)) Then
					dic(Trim(Split(strLine, "=")(0))) = Trim(Split(strLine, "=")(1))
				Else
					dic.Add Trim(Split(strLine, "=")(0)), Trim(Split(strLine, "=")(1))
				End If
			End If
		Loop
		ts.Close
	End If
	Set FileToDictionary = dic
End Function

Sub DictionaryExecute(dic)
'Assuming a dictionary full of variable names And
'values, sets all the variables to the values
Dim colNames, strName
	colNames = dic.Keys
	For Each strName In colNames
		Execute Trim(strName) & " = " & Trim(dic(strName))
	Next
End Sub

Function DictionaryGUI(dic)
'Displays a dictionary and allows you to edit all elements
'Modifies input dictionary! Returns boolean true if user 
'checks the "save" checkbox
Dim fs, web, doc
Dim strFile, strChoice
Dim intChars
Dim dtTime
Dim colNames
	On Error Resume Next
	Set web = CreateObject("InternetExplorer.Application")
	If web Is Nothing Then
		DictionaryGUI = False
		Exit Function
	End If

	web.Width = 500
	web.Height = 650
	web.Offline = True
	web.AddressBar = False
	web.MenuBar = False
	web.StatusBar = False
	web.Silent = True
	web.ToolBar = False
	web.Navigate "about:blank"
	'Wait for the browser to navigate to nowhere
	dtTime = Now
	Do While web.Busy
		'Don't wait more than 5 seconds
		Wscript.Sleep 100
		If (dtTime + 5/24/60/60) < Now Then
			web.Quit
			DictionaryGUI = False
			Exit Function
		End If
	Loop
	'Wait for a good reference to the browser document
	Set doc = Nothing
	dtTime = Now
	Do Until Not doc Is Nothing
		Wscript.Sleep 100
		Set doc = web.Document
		'Don't wait more than 5 seconds
		If (dtTime + 5/24/60/60) < Now Then
			web.Quit
			DictionaryGUI = False
			Exit Function
		End If
	Loop
	'Write the HTML form
	doc.Write "<html><head><title>" & WScript.ScriptName & " Settings</title></head>" & vbCrLf
	doc.Write "<body><b>""" & WScript.ScriptName & """</b> settings<br>" & vbCrLf
	doc.Write WScript.Arguments(0) & "<br>" & vbCrLf
	doc.Write "<font size=""-1""><i>Strings entered below should be quoted.</i></font>" & vbCrLf
	doc.Write "<form>" & vbCrLf
	colNames = dic.Keys
	doc.Write "<table border=""0"">" & vbCrLf
	For Each strName In colNames
		'Write the form input string
		doc.Write "<tr><td>" &  strName & "</td><td><input name=""" & strName & """ value='" & dic(strName) & "'></td></tr>" & vbCrLf
	Next
	doc.Write "<tr><td>Save to INI, don't ask again</td>"
	doc.Write "<td><input type=""checkbox"" name=""save"" value=""true"" unchecked></td></tr>" & vbCrLf
	doc.Write "</table><br>" & vbCrLf
	doc.Write "<br><input type=""button"" "
	doc.Write "name=""submit"" "
	doc.Write "value=""OK"" onclick='javascript:submit.value=""Done""'>"
	doc.Write "</form>" & vbCrLf
	doc.Write "</body></html>"
	'Show the form
	web.Visible = True
	'Wait for the user to choose, but fail gracefully if a popup killer.
	Err.Clear
	Do Until doc.Forms(0).elements("submit").Value <> "OK"
		Wscript.Sleep 100
		If doc Is Nothing Then
			web.Quit
			DictionaryGUI = False
			Exit Function
		End If
		If Err.Number <> 0 Then
			web.Quit
			DictionaryGUI = False
			Exit Function
		End If
	Loop
	'Retrieve the chosen value
	colNames = dic.Keys
	For Each strName In colNames
		If InStr(Trim(doc.Forms(0).elements(strName).Value), " ") = 0 Then
			dic(strName) = doc.Forms(0).elements(strName).Value
		Else
			If Left(doc.Forms(0).elements(strName).Value, 1) <> """" Then
				doc.Forms(0).elements(strName).Value = """" & doc.Forms(0).elements(strName).Value
			End If
			If Right(doc.Forms(0).elements(strName).Value, 1) <> """" Then
				doc.Forms(0).elements(strName).Value = doc.Forms(0).elements(strName).Value & """"
			End If
			dic(strName) = doc.Forms(0).elements(strName).Value
		End If
	Next
	DictionaryGUI = doc.Forms(0).elements("save").checked
	web.Quit
End Function

Function FileNameLikeMine(strFileExtension) 'As String
'Returns a file name the same as the script name except
'for the file extension. 
Dim fs 'As Object
Dim strExtension 'As String
	Set fs = CreateObject("Scripting.FileSystemObject")
	strExtension = strFileExtension
	If Len(strExtension) < 1 Then strExtension = "txt"
	If strExtension = "." Then strExtension = "txt"
	If Left(strExtension,1) = "." Then strExtension = Mid(strExtension, 2)
	FileNameLikeMine = Left(Wscript.ScriptFullName, InstrRev(Wscript.ScriptFullName, ".")) & strExtension
End Function

Function MakeAVSFile(strSourceFile, strBaseName, strOutputPath)
'Returns path to created file if successfull, otherwise returns empty string
Dim ws, fs, strOutputFile, strAvsText
	Set fs = CreateObject("Scripting.FileSystemObject")
	Set ws = CreateObject("Wscript.Shell")
	On Error Resume Next 'in case RegRead fails!
	'Bail out immediately if the global variable says to
	If Not PERMANENT_SUBTITLES Then
		MakeAVSFile = ""
		Exit Function
	End If
	'Is AVISynth is installed?
	If Not("avsfile" = ws.RegRead("HKCR\.avs\")) Then
		MakeAVSFile = ""
		Exit Function
	End If
	'Is ffdshow installed?
	If Not("en" = ws.RegRead("HKEY_CURRENT_USER\Software\GNU\ffdshow\lang")) Then
		MakeAVSFile = ""
		Exit Function
	End If
	'Make the AVS file
	strOutputFile = fs.BuildPath(strOutputPath, strBaseName & ".avs")
	strAvsText = "DirectShowSource(" & """" & strSourceFile & """" & ")"
	'Toss a couple extra frames in to help audio sync
	strAvsText = strAvsText & vbCrLf & "DuplicateFrame(0)"
	strAvsText = strAvsText & vbCrLf & "DuplicateFrame(0)"
	strAvsText = strAvsText & vbCrLf & "DuplicateFrame(0)"
	strAvsText = strAvsText & vbCrLf & "DuplicateFrame(0)"
	strAvsText = strAvsText & vbCrLf & "DuplicateFrame(0)"
	strAvsText = strAvsText & vbCrLf & "DuplicateFrame(0)"
	strAvsText = strAvsText & vbCrLf & "DuplicateFrame(0)"
	strAvsText = strAvsText & vbCrLf & "DuplicateFrame(0)"
	String2File strAvsText, strOutputFile
	'Wait for antivirus to allow file creation
	WScript.Sleep 500
	'Return a value
	If fs.FileExists(strOutputFile) Then
		MakeAVSFile = strOutputFile
	Else
		MakeAVSFile = ""
	End If
End Function

Sub ToggleRightClick(strFileExtension)
' Adds or deletes this script as a right-click option to and extension (like ".mpg")
Dim ws, fs, strKey1, strKey2
	Set ws = CreateObject("Wscript.Shell")
	Set fs = CreateObject("Scripting.FileSystemObject")
	
	If strFileExtension = "" Then Exit Sub
	If Sanitize(strFileExtension) <> strFileExtension Then Exit Sub
	If Left(strFileExtension, 1) <> "." Then strFileExtension = "." & strFileExtension
	strKey1 = ""
	On Error Resume Next
	strKey1 = ws.RegRead("HKEY_CLASSES_ROOT\" & strFileExtension & "\")
	If strKey1 = "" Then
		MsgBox "That file type is not registered. No action taken"
		Exit Sub
	End If
	
	strKey2 = "HKEY_CLASSES_ROOT\" & strKey1 & "\shell\" & fs.GetBaseName(WScript.ScriptName) & "\"
	If RightClickEnabled(strFileExtension) Then
		ws.RegDelete strKey2 & "command\"
		ws.RegDelete strKey2
		MsgBox "Right-Click option for """ & strKey1 & """ for this script has been REMOVED",,fs.GetBaseName(WScript.ScriptName)
	Else
		ws.RegWrite strKey2 & "command\", "cscript.exe """ & WScript.ScriptFullName & """ ""%1""", "REG_EXPAND_SZ"
		MsgBox "Right-Click option for """ & strKey1 & """ for this script has been ADDED",,fs.GetBaseName(WScript.ScriptName)
	End If
End Sub

Function RightClickStatus(strFileExtension)
	If RightClickEnabled(strFileExtension) Then
		RightClickStatus = "ENABLED"
	Else
		RightClickStatus = "DISABLED"
	End If
End Function

Function RightClickEnabled(strFileExtension)
Dim ws, fs, strKey1, strKey2
	Set ws = CreateObject("Wscript.Shell")
	Set fs = CreateObject("Scripting.FileSystemObject")
	strKey2 = ""
	On Error Resume Next
	strKey1 = ws.RegRead("HKEY_CLASSES_ROOT\" & strFileExtension & "\")
	strKey2 = ws.RegRead("HKEY_CLASSES_ROOT\" & strKey1 & "\shell\" & fs.GetBaseName(WScript.ScriptName) & "\command\")
	On Error Goto 0
	RightClickEnabled = Eval("" <> strKey2)
End Function