'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