'Drop a saved VirtualDub configuration file (VCF file) 
'on this script and it will create a ".jobs" file for 
'all video files in a directory of your choosing. You 
'can also pass VCF file, source directory, and 
'destination directory on the command line (in that 
'order). 
'
'The ".jobs" file created by this script will always 
'be in the script's directory and will have the same 
'base name as the script.
'
'VirtualDub should NOT be running while it's jobs file 
'is being modified.
'
'Eric Phelps
'June 2003
'http://www.ericphelps.com/
'Public Domain. No restrictions. No warranty.

Option Explicit
Main

Sub Main
Dim strVcfFile, strVcfData
Dim strInputDirectory, strOutputDirectory
Dim strMessage, strExtensions, strExtension
Dim fs, fil, fils, fols, fol
Dim dtCreated
Dim intCounter
	Set fs = CreateObject("Scripting.FileSystemObject")
	'Get the VCF data
	If WScript.Arguments.Count > 0 Then 
		strVcfFile = WScript.Arguments(0)
	Else
		strVcfFile = BrowseForFile("Select a VirtualDub ""VCF"" configuration file to use:")
	End If
	If strVcfFile = "" Then Exit Sub 'User hit Cancel on file selection dialog
	If Not fs.FileExists(strVcfFile) Then
		 MsgBox "File error: " & strVcfFile
		 Exit Sub
	End If
	If Lcase(Right(strVcfFile, 4)) <> ".vcf" Then
		MsgBox "A VCF file has to have a VCF file extension! The file you chose doesn't."
		Exit Sub
	End If
	strVcfData = File2String(strVcfFile)
	If InStr(strVcfData, "VirtualDub.") = 0 Then
		MsgBox "Not a valid VCF file!"
		Exit Sub
	End If
	'Process what kind of files?
	strExtensions = InputBox("Process what types of files (comma-delimited list)?",,"avi, mpg, mpeg")
	'Get the input directory
	If WScript.Arguments.Count > 1 Then 
		strInputDirectory = WScript.Arguments(1)
	Else
		strInputDirectory = fs.GetParentFolderName(strVcfFile)
		strInputDirectory = BrowseForFolder("Source directory: " & vbCrLf & "(Cancel=""" & strInputDirectory & """)")
		If strInputDirectory = "" Then strInputDirectory = fs.GetParentFolderName(strVcfFile)
	End If
	If Not fs.FolderExists(strInputDirectory) Then
		MsgBox "Selected directory does not exist"
		Exit Sub
	End If
	'Count the source files
	Set fils = fs.GetFolder(strInputDirectory).Files
	intCounter = 0
	For Each fil In fils
		For Each strExtension In Split(strExtensions, ",")
			If Lcase(Mid(fil.Name, InStrRev(fil.Name, ".") + 1)) = Lcase(Trim(strExtension)) Then 
				intCounter = intCounter + 1
				Exit For
			End If
		Next
	Next
	If intCounter = 0 Then
		MsgBox "No " & strExtensions & " files found"
		Exit Sub
	End If
	'Get the output directory
	If WScript.Arguments.Count > 2 Then 
		strOutputDirectory = WScript.Arguments(2)
	Else
		 'Try to guess the output directory to save drill-down time
		 Set fols = fs.GetFolder(strInputDirectory).SubFolders
		 If fols.Count <> 0 Then
			 'Pick the most recently accessed sub-folder as the default
			 dtCreated = Now() - 100000
			 For Each fol In fols
				 If fol.DateCreated > dtCreated Then
					 strOutPutDirectory = fol.Path
					 dtCreated = fol.DateCreated
				 End If
			 Next
		 Else
			 'pick the parent folder
			 If Len(strInputDirectory) > 3 Then
			 	strOutputDirectory = fs.GetFolder(strInputDirectory).ParentFolder.Path
			 Else
			 	strOutPutDirectory = fs.GetFolder(".").Path
			 End If
		 End If
		 'Remember our choice
		 Set fol = fs.GetFolder(strOutputDirectory)
		strOutputDirectory = BrowseForFolder("Destination directory: " & vbCrLf & "(Cancel=""" & strOutputDirectory & """)")
		If strOutputDirectory = "" Then strOutputDirectory = fol.Path
	End If
	If Not fs.FolderExists(strOutputDirectory) Then
		MsgBox "Selected directory does not exist"
		Exit Sub
	End If
	If strOutputDirectory = strInputDirectory Then
		MsgBox "Destination directory can't be the same as source directory because the output files will have the same names as the input files!"
		Exit Sub
	End If
	'Start the job file with the count
	String2File "//" & vbCrLf & "// $numjobs " & intCounter & vbCrLf & "//" & vbCrLf, FileNameLikeMine("jobs")
	'Process all AVI files
	For Each fil In fils
		For Each strExtension In Split(strExtensions, ",")
			If Lcase(Mid(fil.Name, InStrRev(fil.Name, ".") + 1)) = Lcase(Trim(strExtension)) Then 
				AddJob fil.Name, strInputDirectory, strOutputDirectory, strVcfData
				Exit For
			End If
		Next
	Next
	'Display the "finished" message
	MsgBox "Job file """ & FileNameLikeMine("jobs") & """ created." & vbCrLf & "Reminder: If the ""jobs"" file isn't in the VirtualDub program folder, you'll need to move it. If VirtualDub is running, you'll need to restart it before it will see your new ""jobs"" file."
End Sub

Sub AddJob(strFile, strInDir, strOutDir, strVcf)
'Adds a job to the jobs file
Dim fs, ts
Const ForAppending = 8
	Set fs = CreateObject("Scripting.FileSystemObject")
	Set ts = fs.OpenTextFile(FileNameLikeMine("jobs"), ForAppending, True)
	ts.WriteLine "// $job """ & strFile & """"
	ts.Write "// $input """
	ts.Write fs.BuildPath(strInDir, strFile)
	ts.WriteLine """"
	ts.Write "// $output """
	ts.Write fs.BuildPath(strOutDir, strFile)
	ts.WriteLine """"
	ts.WriteLine "// $state 0"
	ts.WriteLine "// $start_time 0 0"
	ts.WriteLine "// $end_time 0 0"
	ts.WriteLine "// $script"
	ts.WriteLine ""
	ts.Write "VirtualDub.Open("""
	ts.Write Replace(fs.BuildPath(strInDir, strFile), "\", "\\")
	ts.WriteLine """,0,0);"
	ts.WriteLine strVcf
	ts.Write "VirtualDub.SaveAVI("""
	ts.Write Replace(fs.BuildPath(strOutDir, strFile), "\", "\\")
	ts.WriteLine """);"
	ts.WriteLine "VirtualDub.Close();"
	ts.WriteLine ""
	ts.WriteLine "// $endjob"
	ts.WriteLine "//"
	ts.WriteLine "//--------------------------------------------------"
	ts.Close
End Sub

Function BrowseForFolder(strPrompt)
'Uses the "Shell.Application" (only present in Win98 and newer)
'to bring up a file/folder selection window. Falls back to an
'ugly input box under Win95.
'Shell32.ShellSpecialFolderConstants
Const ssfPERSONAL = 5 'My Documents
Const ssfDRIVES = 17 'My Computer
Const SFVVO_SHOWALLOBJECTS = 1
Const SFVVO_SHOWEXTENSIONS = 2 
	Dim sh, fol, fs, lngView, strPath
	Set sh = CreateObject("Shell.Application")
	If Instr(TypeName(sh), "Shell") = 0 Then
		BrowseForFolder = InputBox(strPrompt, "Select Folder", CreateObject("Scripting.FileSystemObject").GetParentFolderName(WScript.ScriptFullName))
		Exit Function
	End If
	Set fs = CreateObject("Scripting.FileSystemObject")
	lngView = SFVVO_SHOWALLOBJECTS Or SFVVO_SHOWEXTENSIONS
	strPath = ""
	Set fol = sh.BrowseForFolder(&0, strPrompt, lngView, ssfDRIVES)
	Err.Clear
	On Error Resume Next
	strPath = fol.ParentFolder.ParseName(fol.Title).Path
	'An error occurs if the user selects a drive instead of a folder
	If Err.Number <> 0 Then
		BrowseForFolder = Left(Right(fol.Title, 3), 2) & "\"
	Else
		BrowseForFolder = strPath
	End If
End Function

Function BrowseForFile(strPrompt)
'Uses the "Shell.Application" (only present in Win98 and newer)
'to bring up a file/folder selection window. Falls back to an
'ugly input box under Win95.
'Shell32.ShellSpecialFolderConstants
Const ssfPERSONAL = 5 'My Documents
Const ssfDRIVES = 17 'My Computer
Const SFVVO_SHOWALLOBJECTS = 1 
Const SFVVO_SHOWEXTENSIONS = 2
Const SFVVO_SHOWFILES = 16384
	Dim sh, fol, fs, lngView, strPath
	Set sh = CreateObject("Shell.Application")
	If Instr(TypeName(sh), "Shell") = 0 Then
		BrowseForFile = InputBox(strPrompt, "Select Folder", CreateObject("Scripting.FileSystemObject").GetParentFolderName(WScript.ScriptFullName) & "\foo.vcf")
		Exit Function
	End If
	Set fs = CreateObject("Scripting.FileSystemObject")
	lngView = SFVVO_SHOWALLOBJECTS Or SFVVO_SHOWEXTENSIONS Or SFVVO_SHOWFILES
	strPath = ""
	On Error Resume Next
	Err.Clear
	Set fol = sh.BrowseForFolder(&0, strPrompt, lngView, ssfDRIVES)
	If Err.Number <> 0 Then
		BrowseForFile = "Sorry, I can't handle files in the root directory!" 'Will throw an error
		Exit Function
	End If
	strPath = fol.ParentFolder.ParseName(fol.Title).Path
	If strPath = "" Then
		strPath = fol.Title
		Set fol = fol.ParentFolder
		strPath = fs.BuildPath(fol.ParentFolder.ParseName(fol.Title).Path, strPath)
	End If
	BrowseForFile = strPath
End Function

Function File2String(strFile) 'As String
'Reads a file and returns the contents as a string
Dim fs 'As Scripting.FileSystemObject
Dim ts 'As Scripting.TextStream
Const ForReading = 1
	Set fs = CreateObject("Scripting.FileSystemObject")
	If fs.FileExists(strFile) Then
		Set ts = fs.OpenTextFile(strFile, ForReading, True)
		If ts.AtEndOfStream Then
			File2String =""
		Else
			File2String = ts.ReadAll
		End If
		ts.Close
	Else
		File2String = ""
	End If
End Function

Sub String2File(strData, strFileName)
'Writes a string to a file
Dim fs 'As Scripting.FileSystemObject
Dim ts 'As Scripting.TextStream
Const ForWriting = 2
	Set fs = CreateObject("Scripting.FileSystemObject")
	Set ts = fs.OpenTextFile(strFileName, ForWriting, True)
	ts.Write(strData)
	ts.Close
End Sub

Sub AppendLineToFile(strText, strFile)
Dim fs 'As Scripting.FileSystemObject
Dim ts 'As Scripting.TextStream
Const ForAppending = 8
	Set fs = CreateObject("Scripting.FileSystemObject")
	Set ts = fs.OpenTextFile(strFile, ForAppending, True)
	ts.WriteLine strText
	ts.Close
End Sub

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